Time Series Project

Spring 2024

Data

Introduce dataset, response variable, and scenario. ACFs and Spectral Density plots.

library(dplyr)
library(lubridate)
bike_data <- read_csv("https://raw.githubusercontent.com/NickSager/MSDS-6373-Time-Series/master/Project/bike_data.csv")

Rows: 17379 Columns: 14
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr  (1): Date
dbl (13): Season, Hour, Holiday, Day of the Week, Working Day, Weather Type,...

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

plotts.sample.wge(bike_data$`Total Users`)$xbar

[1] 189.4631

# make the bike data daily instead of hourly 
daily_bike_data <- bike_data %>%
  group_by(Date = as.Date(Date, format = "%m/%d/%Y")) %>%
  summarise(
    Season = mean(Season),
    Hour = mean(Hour),
    Holiday = mean(Holiday),
    Day_of_the_Week = mean(`Day of the Week`),
    Working_Day = mean(`Working Day`),
    Weather_Type = mean(`Weather Type`),
    Temperature = mean(`Temperature F`),
    Temperature_Feels = mean(`Temperature Feels F`),
    Humidity = mean(Humidity),
    Wind_Speed = mean(`Wind Speed`),
    Casual_Users = sum(`Casual Users`),
    Registered_Users = sum(`Registered Users`),
    Total_Users = sum(`Total Users`), 
  )

plotts.sample.wge(daily_bike_data$Total_Users)$xbar

[1] 4504.349

Models

Univariate: At least 2 candidate ARMA / ARIMA models

ARMA Model

# create model 
plotts.sample.wge(daily_bike_data$Total_Users)$xbar # looking at the spectral density it looks like there may be wandering behavior

[1] 4504.349

aic5.wge(daily_bike_data$Total_Users,type = 'bic', p = 0:10) # bic picked p = 7 and q = 0

---------WORKING... PLEASE WAIT... 


Five Smallest Values of  bic 
    p    q        bic
    2    1   13.69076
    1    2   13.69813
    3    1   13.69839
    2    2   13.70129
    4    1   13.70332

arma_est = est.arma.wge(daily_bike_data$Total_Users, p = 4, q = 1)

  
  
Coefficients of AR polynomial:  
1.3314 -0.3662 -0.0398 0.0714 

                           AR Factor Table 
Factor                 Roots                Abs Recip    System Freq 
1-0.9958B              1.0042               0.9958       0.0000
1-0.6451B+0.2316B^2    1.3928+-1.5422i      0.4812       0.1331
1+0.3094B             -3.2316               0.3094       0.5000
  
  
  
  
Coefficients of MA polynomial:  
0.8546 

                              MA FACTOR TABLE 
Factor                 Roots                Abs Recip    System Freq 
1-0.8546B              1.1701               0.8546       0.0000
  
  

arma_est$aic

[1] 13.66561

# Checking the residuals to see if the model is appropriate 
plotts.wge(arma_est$res) # looks random

acf(arma_est$res) # all acfs are within the bounds 

ljung.wge(arma_est$res) # greater than 0.05

Obs -0.005010004 -0.003450221 0.01480044 -0.03744856 -0.02388224 0.07102734 -0.002346559 0.001844206 -0.03703603 -0.0003221056 -0.0360136 -0.02088753 -0.05011817 0.06717895 0.05352861 -0.03713366 0.00773877 -0.02832128 -0.0368374 0.01091766 0.06247802 0.02236151 -0.0003161035 0.0004286526 

$test
[1] "Ljung-Box test"

$K
[1] 24

$chi.square
[1] 21.194

$df
[1] 24

$pval
[1] 0.6272555

ljung.wge(arma_est$res, K =48) # greater than 0.05

Obs -0.005010004 -0.003450221 0.01480044 -0.03744856 -0.02388224 0.07102734 -0.002346559 0.001844206 -0.03703603 -0.0003221056 -0.0360136 -0.02088753 -0.05011817 0.06717895 0.05352861 -0.03713366 0.00773877 -0.02832128 -0.0368374 0.01091766 0.06247802 0.02236151 -0.0003161035 0.0004286526 -0.03171432 0.05577033 0.04034666 0.05299114 0.1208076 -0.04854243 -0.03178664 -0.05689576 0.004107775 0.01089672 0.01941488 -0.01326279 0.04949783 -0.06636284 0.02427643 -0.04003327 0.04276193 0.01389513 0.01483702 -0.006516272 -0.05228082 0.003175496 0.01971463 0.009272811 

$test
[1] "Ljung-Box test"

$K
[1] 48

$chi.square
[1] 55.71162

$df
[1] 48

$pval
[1] 0.2073317

arma_gen1 = gen.aruma.wge(200, phi = arma_est$phi, theta = arma_est$theta)

arma_gen2 = gen.arima.wge(200, phi = arma_est$phi, theta = arma_est$theta)

arma_gen3 = gen.arima.wge(200, phi = arma_est$phi, theta = arma_est$theta)

arma_gen4 = gen.arima.wge(200, phi = arma_est$phi, theta = arma_est$theta)

plotts.sample.wge(arma_gen1)$xbar

[1] -4.324042

plotts.sample.wge(arma_gen2)$xbar

[1] 0.3376069

plotts.sample.wge(arma_gen3)$xbar

[1] 0.6002494

plotts.sample.wge(arma_gen4)$xbar # all these 4 random realizations have the same behavior as the original data so the model seems to be appropriate

[1] -0.6973725

# Compare Spectral Densities: 
sims = 20
SpecDen = parzen.wge(daily_bike_data$Total_Users, plot = "FALSE")
plot(SpecDen$freq,SpecDen$pzgram, type = "l", lwd = 6)

for( i in 1: sims){
   SpecDen2 = parzen.wge(gen.aruma.wge(length(daily_bike_data$Total_Users), phi = arma_est$phi, theta = arma_est$theta, plot ="FALSE"), plot = "FALSE")
   lines(SpecDen2$freq,SpecDen2$pzgram, lwd = 2, col = "red")
}

# Compare ACFs:
sims = 20
ACF = acf(daily_bike_data$Total_Users, plot = "FALSE")
plot(ACF$lag ,ACF$acf , type = "l", lwd = 6)

for( i in 1: sims)
{
   ACF2 = acf(gen.aruma.wge(length(daily_bike_data$Total_Users), phi = arma_est$phi, theta = arma_est$theta, plot ="FALSE"), plot = "FALSE")
   lines(ACF2$lag ,ACF2$acf, lwd = 2, col = "red")
}

\[\phi(B) = \theta(B)\] \[(1-1.33140459c+0.36616800B^2+0.03983356B^3-0.07135681B^4) = (1 - 0.8546105B)\]

# plot of Last N forecasts for short and long term horizon 
arma_stfore1 = fore.arima.wge(daily_bike_data$Total_Users, phi = arma_est$phi, theta = arma_est$theta, n.ahead = 7, lastn = TRUE)

y.arma 985 801 1349 1562 1600 1606 1510 959 822 1321 1263 1162 1406 1421 1248 1204 1000 683 1650 1927 1543 981 986 1416 1985 506 431 1167 1098 1096 1501 1360 1526 1550 1708 1005 1623 1712 1530 1605 1538 1746 1472 1589 1913 1815 2115 2475 2927 1635 1812 1107 1450 1917 1807 1461 1969 2402 1446 1851 2134 1685 1944 2077 605 1872 2133 1891 623 1977 2132 2417 2046 2056 2192 2744 3239 3117 2471 2077 2703 2121 1865 2210 2496 1693 2028 2425 1536 1685 2227 2252 3249 3115 1795 2808 3141 1471 2455 2895 3348 2034 2162 3267 3126 795 3744 3429 3204 3944 4189 1683 4036 4191 4073 4400 3872 4058 4595 5312 3351 4401 4451 2633 4433 4608 4714 4333 4362 4803 4182 4864 4105 3409 4553 3958 4123 3855 4575 4917 5805 4660 4274 4492 4978 4677 4679 4758 4788 4098 3982 3974 4968 5312 5342 4906 4548 4833 4401 3915 4586 4966 4460 5020 4891 5180 3767 4844 5119 4744 4010 4835 4507 4790 4991 5202 5305 4708 4648 5225 5515 5362 5119 4649 6043 4665 4629 4592 4040 5336 4881 4086 4258 4342 5084 5538 5923 5302 4458 4541 4332 3784 3387 3285 3606 3840 4590 4656 4390 3846 4475 4302 4266 4845 3574 4576 4866 4294 3785 4326 4602 4780 4792 4905 4150 3820 4338 4725 4694 3805 4153 5191 3873 4758 5895 5130 3542 4661 1115 4334 4634 5204 5058 5115 4727 4484 4940 3351 2710 1996 1842 3544 5345 5046 4713 4763 4785 3659 4760 4511 4274 4539 3641 4352 4795 2395 5423 5010 4630 4120 3907 4839 5202 2429 2918 3570 4456 4826 4765 4985 5409 5511 5117 4563 2416 2913 3644 5217 5041 4570 4748 2424 4195 4304 4308 4381 4187 4687 3894 2659 3747 627 3331 3669 4068 4186 3974 4046 3926 3649 4035 4205 4109 2933 3368 4067 3717 4486 4195 1817 3053 3392 3663 3520 2765 1607 2566 1495 2792 3068 3071 3867 2914 3613 3727 3940 3614 3485 3811 2594 705 3322 3620 3190 2743 3310 3523 3740 3709 3577 2739 2431 3403 3750 2660 3068 2209 1011 754 1317 1162 2302 2423 2999 2485 2294 1951 2236 2368 3272 4098 4521 3425 2376 3598 2177 4097 3214 2493 2311 2298 2935 3376 3292 3163 1301 1977 2432 4339 4270 4075 3456 4023 3243 3624 4509 4579 3761 4151 2832 2947 3784 4375 2802 3830 3831 2169 1529 3422 3922 4169 3005 4154 4318 2689 3129 3777 4773 5062 3487 2732 3389 4322 4363 1834 4990 3194 4066 3423 3333 3956 4916 5382 4569 4118 4911 5298 5847 6312 6192 4378 7836 5892 6153 6093 6230 6871 8362 3372 4996 5558 5102 5698 6133 5459 6235 6041 5936 6772 6436 6457 6460 6857 5169 5585 5918 4862 5409 6398 7460 7132 6370 6691 4367 6565 7290 6624 1027 3214 5633 6196 5026 6233 4220 6304 5572 5740 6169 6421 6296 6883 6359 6273 5728 4717 6572 7030 7429 6118 2843 5115 7424 7384 7639 8294 7129 4359 6073 5260 6770 6734 6536 6591 6043 5743 6855 7338 4127 8120 7641 6998 7001 7055 7494 7736 7498 6598 6664 4972 7421 7363 7665 7702 6978 5099 6825 6211 5905 5823 7458 6891 6779 7442 7335 6879 5463 5687 5531 6227 6660 7403 6241 6207 4840 4672 6569 6290 7264 7446 7499 6969 6031 6830 6786 5713 6591 5870 4459 7410 6966 7592 8173 6861 6904 6685 6597 7105 7216 7580 7261 7175 6824 5464 7013 7273 7534 7286 5786 6299 6544 6883 6784 7347 7605 7148 7865 4549 6530 7006 7375 7765 7582 6053 5255 6917 7040 7697 7713 7350 6140 5810 6034 6864 7112 6203 7504 5976 8227 7525 7767 7870 7804 8009 8714 7333 6869 4073 7591 7720 8167 8395 7907 7436 7538 7733 7393 7415 8555 6889 6778 4639 7572 7328 8156 7965 3510 5478 6392 7691 7570 7282 7109 6639 5875 7534 7461 7509 5424 8090 6824 7058 7466 7693 7359 7444 7852 4459 22 1096 5566 5986 5847 5138 5107 5259 5686 5035 5315 5992 6536 6852 6269 4094 5495 5445 5698 5629 4669 5499 5634 5146 2425 3910 2277 2424 5087 3959 5260 5323 5668 5191 4649 6234 6606 5729 5375 5008 5582 3228 5170 5501 5319 5532 5611 5047 3786 4585 5557 5267 4128 3623 1749 1787 920 1013 441 2114 3095 1341 1796 2729 

arma_ltfore1 = fore.arima.wge(daily_bike_data$Total_Users, phi = arma_est$phi, theta = arma_est$theta, n.ahead = 60, lastn = TRUE)

y.arma 985 801 1349 1562 1600 1606 1510 959 822 1321 1263 1162 1406 1421 1248 1204 1000 683 1650 1927 1543 981 986 1416 1985 506 431 1167 1098 1096 1501 1360 1526 1550 1708 1005 1623 1712 1530 1605 1538 1746 1472 1589 1913 1815 2115 2475 2927 1635 1812 1107 1450 1917 1807 1461 1969 2402 1446 1851 2134 1685 1944 2077 605 1872 2133 1891 623 1977 2132 2417 2046 2056 2192 2744 3239 3117 2471 2077 2703 2121 1865 2210 2496 1693 2028 2425 1536 1685 2227 2252 3249 3115 1795 2808 3141 1471 2455 2895 3348 2034 2162 3267 3126 795 3744 3429 3204 3944 4189 1683 4036 4191 4073 4400 3872 4058 4595 5312 3351 4401 4451 2633 4433 4608 4714 4333 4362 4803 4182 4864 4105 3409 4553 3958 4123 3855 4575 4917 5805 4660 4274 4492 4978 4677 4679 4758 4788 4098 3982 3974 4968 5312 5342 4906 4548 4833 4401 3915 4586 4966 4460 5020 4891 5180 3767 4844 5119 4744 4010 4835 4507 4790 4991 5202 5305 4708 4648 5225 5515 5362 5119 4649 6043 4665 4629 4592 4040 5336 4881 4086 4258 4342 5084 5538 5923 5302 4458 4541 4332 3784 3387 3285 3606 3840 4590 4656 4390 3846 4475 4302 4266 4845 3574 4576 4866 4294 3785 4326 4602 4780 4792 4905 4150 3820 4338 4725 4694 3805 4153 5191 3873 4758 5895 5130 3542 4661 1115 4334 4634 5204 5058 5115 4727 4484 4940 3351 2710 1996 1842 3544 5345 5046 4713 4763 4785 3659 4760 4511 4274 4539 3641 4352 4795 2395 5423 5010 4630 4120 3907 4839 5202 2429 2918 3570 4456 4826 4765 4985 5409 5511 5117 4563 2416 2913 3644 5217 5041 4570 4748 2424 4195 4304 4308 4381 4187 4687 3894 2659 3747 627 3331 3669 4068 4186 3974 4046 3926 3649 4035 4205 4109 2933 3368 4067 3717 4486 4195 1817 3053 3392 3663 3520 2765 1607 2566 1495 2792 3068 3071 3867 2914 3613 3727 3940 3614 3485 3811 2594 705 3322 3620 3190 2743 3310 3523 3740 3709 3577 2739 2431 3403 3750 2660 3068 2209 1011 754 1317 1162 2302 2423 2999 2485 2294 1951 2236 2368 3272 4098 4521 3425 2376 3598 2177 4097 3214 2493 2311 2298 2935 3376 3292 3163 1301 1977 2432 4339 4270 4075 3456 4023 3243 3624 4509 4579 3761 4151 2832 2947 3784 4375 2802 3830 3831 2169 1529 3422 3922 4169 3005 4154 4318 2689 3129 3777 4773 5062 3487 2732 3389 4322 4363 1834 4990 3194 4066 3423 3333 3956 4916 5382 4569 4118 4911 5298 5847 6312 6192 4378 7836 5892 6153 6093 6230 6871 8362 3372 4996 5558 5102 5698 6133 5459 6235 6041 5936 6772 6436 6457 6460 6857 5169 5585 5918 4862 5409 6398 7460 7132 6370 6691 4367 6565 7290 6624 1027 3214 5633 6196 5026 6233 4220 6304 5572 5740 6169 6421 6296 6883 6359 6273 5728 4717 6572 7030 7429 6118 2843 5115 7424 7384 7639 8294 7129 4359 6073 5260 6770 6734 6536 6591 6043 5743 6855 7338 4127 8120 7641 6998 7001 7055 7494 7736 7498 6598 6664 4972 7421 7363 7665 7702 6978 5099 6825 6211 5905 5823 7458 6891 6779 7442 7335 6879 5463 5687 5531 6227 6660 7403 6241 6207 4840 4672 6569 6290 7264 7446 7499 6969 6031 6830 6786 5713 6591 5870 4459 7410 6966 7592 8173 6861 6904 6685 6597 7105 7216 7580 7261 7175 6824 5464 7013 7273 7534 7286 5786 6299 6544 6883 6784 7347 7605 7148 7865 4549 6530 7006 7375 7765 7582 6053 5255 6917 7040 7697 7713 7350 6140 5810 6034 6864 7112 6203 7504 5976 8227 7525 7767 7870 7804 8009 8714 7333 6869 4073 7591 7720 8167 8395 7907 7436 7538 7733 7393 7415 8555 6889 6778 4639 7572 7328 8156 7965 3510 5478 6392 7691 7570 7282 7109 6639 5875 7534 7461 7509 5424 8090 6824 7058 7466 7693 7359 7444 7852 4459 22 1096 5566 5986 5847 5138 5107 5259 5686 5035 5315 5992 6536 6852 6269 4094 5495 5445 5698 5629 4669 5499 5634 5146 2425 3910 2277 2424 5087 3959 5260 5323 5668 5191 4649 6234 6606 5729 5375 5008 5582 3228 5170 5501 5319 5532 5611 5047 3786 4585 5557 5267 4128 3623 1749 1787 920 1013 441 2114 3095 1341 1796 2729 

t = 1:length(daily_bike_data$Total_Users)
plot(t[720:731],daily_bike_data$Total_Users[720:731], type = 'l', xlab = "Time", ylab = "Total Users")
points(t[725:731], arma_stfore1$f, type="l", lwd=2, lty = 2, col = 'blue')

plot(t[670:731],daily_bike_data$Total_Users[670:731], type = 'l', xlab = "Time", ylab = "Total Users")
points(t[672:731], arma_ltfore1$f, type="l", lwd=2, lty = 2,col = 'blue')

# ASE 
arma_stASE = mean((daily_bike_data$Total_Users[725:731]-arma_stfore1$f)^2)
arma_ltASE = mean((daily_bike_data$Total_Users[672:731]-arma_ltfore1$f)^2)
arma_stASE

[1] 3358954

arma_ltASE

[1] 3058217

# Rolling Window RMSE
# RW-RMSE commented out due to obscene amount of unsupressable output
# arma_strwRMSE = roll.win.rmse.wge(daily_bike_data$Total_Users, horizon = 7, phi = arma_est$phi, theta = arma_est$theta, s = 2)$rwRMSE
# arma_ltrwRMSE = roll.win.rmse.wge(daily_bike_data$Total_Users, horizon = 60, phi = arma_est$phi, theta = arma_est$theta, s = 2)$rwRMSE

arma_strwRMSE = 1674.472
arma_ltrwRMSE = 6297.147

arma_stfore2 = fore.arima.wge(daily_bike_data$Total_Users, phi = arma_est$phi, theta = arma_est$theta, n.ahead = 7)

y.arma 985 801 1349 1562 1600 1606 1510 959 822 1321 1263 1162 1406 1421 1248 1204 1000 683 1650 1927 1543 981 986 1416 1985 506 431 1167 1098 1096 1501 1360 1526 1550 1708 1005 1623 1712 1530 1605 1538 1746 1472 1589 1913 1815 2115 2475 2927 1635 1812 1107 1450 1917 1807 1461 1969 2402 1446 1851 2134 1685 1944 2077 605 1872 2133 1891 623 1977 2132 2417 2046 2056 2192 2744 3239 3117 2471 2077 2703 2121 1865 2210 2496 1693 2028 2425 1536 1685 2227 2252 3249 3115 1795 2808 3141 1471 2455 2895 3348 2034 2162 3267 3126 795 3744 3429 3204 3944 4189 1683 4036 4191 4073 4400 3872 4058 4595 5312 3351 4401 4451 2633 4433 4608 4714 4333 4362 4803 4182 4864 4105 3409 4553 3958 4123 3855 4575 4917 5805 4660 4274 4492 4978 4677 4679 4758 4788 4098 3982 3974 4968 5312 5342 4906 4548 4833 4401 3915 4586 4966 4460 5020 4891 5180 3767 4844 5119 4744 4010 4835 4507 4790 4991 5202 5305 4708 4648 5225 5515 5362 5119 4649 6043 4665 4629 4592 4040 5336 4881 4086 4258 4342 5084 5538 5923 5302 4458 4541 4332 3784 3387 3285 3606 3840 4590 4656 4390 3846 4475 4302 4266 4845 3574 4576 4866 4294 3785 4326 4602 4780 4792 4905 4150 3820 4338 4725 4694 3805 4153 5191 3873 4758 5895 5130 3542 4661 1115 4334 4634 5204 5058 5115 4727 4484 4940 3351 2710 1996 1842 3544 5345 5046 4713 4763 4785 3659 4760 4511 4274 4539 3641 4352 4795 2395 5423 5010 4630 4120 3907 4839 5202 2429 2918 3570 4456 4826 4765 4985 5409 5511 5117 4563 2416 2913 3644 5217 5041 4570 4748 2424 4195 4304 4308 4381 4187 4687 3894 2659 3747 627 3331 3669 4068 4186 3974 4046 3926 3649 4035 4205 4109 2933 3368 4067 3717 4486 4195 1817 3053 3392 3663 3520 2765 1607 2566 1495 2792 3068 3071 3867 2914 3613 3727 3940 3614 3485 3811 2594 705 3322 3620 3190 2743 3310 3523 3740 3709 3577 2739 2431 3403 3750 2660 3068 2209 1011 754 1317 1162 2302 2423 2999 2485 2294 1951 2236 2368 3272 4098 4521 3425 2376 3598 2177 4097 3214 2493 2311 2298 2935 3376 3292 3163 1301 1977 2432 4339 4270 4075 3456 4023 3243 3624 4509 4579 3761 4151 2832 2947 3784 4375 2802 3830 3831 2169 1529 3422 3922 4169 3005 4154 4318 2689 3129 3777 4773 5062 3487 2732 3389 4322 4363 1834 4990 3194 4066 3423 3333 3956 4916 5382 4569 4118 4911 5298 5847 6312 6192 4378 7836 5892 6153 6093 6230 6871 8362 3372 4996 5558 5102 5698 6133 5459 6235 6041 5936 6772 6436 6457 6460 6857 5169 5585 5918 4862 5409 6398 7460 7132 6370 6691 4367 6565 7290 6624 1027 3214 5633 6196 5026 6233 4220 6304 5572 5740 6169 6421 6296 6883 6359 6273 5728 4717 6572 7030 7429 6118 2843 5115 7424 7384 7639 8294 7129 4359 6073 5260 6770 6734 6536 6591 6043 5743 6855 7338 4127 8120 7641 6998 7001 7055 7494 7736 7498 6598 6664 4972 7421 7363 7665 7702 6978 5099 6825 6211 5905 5823 7458 6891 6779 7442 7335 6879 5463 5687 5531 6227 6660 7403 6241 6207 4840 4672 6569 6290 7264 7446 7499 6969 6031 6830 6786 5713 6591 5870 4459 7410 6966 7592 8173 6861 6904 6685 6597 7105 7216 7580 7261 7175 6824 5464 7013 7273 7534 7286 5786 6299 6544 6883 6784 7347 7605 7148 7865 4549 6530 7006 7375 7765 7582 6053 5255 6917 7040 7697 7713 7350 6140 5810 6034 6864 7112 6203 7504 5976 8227 7525 7767 7870 7804 8009 8714 7333 6869 4073 7591 7720 8167 8395 7907 7436 7538 7733 7393 7415 8555 6889 6778 4639 7572 7328 8156 7965 3510 5478 6392 7691 7570 7282 7109 6639 5875 7534 7461 7509 5424 8090 6824 7058 7466 7693 7359 7444 7852 4459 22 1096 5566 5986 5847 5138 5107 5259 5686 5035 5315 5992 6536 6852 6269 4094 5495 5445 5698 5629 4669 5499 5634 5146 2425 3910 2277 2424 5087 3959 5260 5323 5668 5191 4649 6234 6606 5729 5375 5008 5582 3228 5170 5501 5319 5532 5611 5047 3786 4585 5557 5267 4128 3623 1749 1787 920 1013 441 2114 3095 1341 1796 2729 

arma_ltfore2 = fore.arima.wge(daily_bike_data$Total_Users, phi = arma_est$phi, theta = arma_est$theta, n.ahead = 60)

y.arma 985 801 1349 1562 1600 1606 1510 959 822 1321 1263 1162 1406 1421 1248 1204 1000 683 1650 1927 1543 981 986 1416 1985 506 431 1167 1098 1096 1501 1360 1526 1550 1708 1005 1623 1712 1530 1605 1538 1746 1472 1589 1913 1815 2115 2475 2927 1635 1812 1107 1450 1917 1807 1461 1969 2402 1446 1851 2134 1685 1944 2077 605 1872 2133 1891 623 1977 2132 2417 2046 2056 2192 2744 3239 3117 2471 2077 2703 2121 1865 2210 2496 1693 2028 2425 1536 1685 2227 2252 3249 3115 1795 2808 3141 1471 2455 2895 3348 2034 2162 3267 3126 795 3744 3429 3204 3944 4189 1683 4036 4191 4073 4400 3872 4058 4595 5312 3351 4401 4451 2633 4433 4608 4714 4333 4362 4803 4182 4864 4105 3409 4553 3958 4123 3855 4575 4917 5805 4660 4274 4492 4978 4677 4679 4758 4788 4098 3982 3974 4968 5312 5342 4906 4548 4833 4401 3915 4586 4966 4460 5020 4891 5180 3767 4844 5119 4744 4010 4835 4507 4790 4991 5202 5305 4708 4648 5225 5515 5362 5119 4649 6043 4665 4629 4592 4040 5336 4881 4086 4258 4342 5084 5538 5923 5302 4458 4541 4332 3784 3387 3285 3606 3840 4590 4656 4390 3846 4475 4302 4266 4845 3574 4576 4866 4294 3785 4326 4602 4780 4792 4905 4150 3820 4338 4725 4694 3805 4153 5191 3873 4758 5895 5130 3542 4661 1115 4334 4634 5204 5058 5115 4727 4484 4940 3351 2710 1996 1842 3544 5345 5046 4713 4763 4785 3659 4760 4511 4274 4539 3641 4352 4795 2395 5423 5010 4630 4120 3907 4839 5202 2429 2918 3570 4456 4826 4765 4985 5409 5511 5117 4563 2416 2913 3644 5217 5041 4570 4748 2424 4195 4304 4308 4381 4187 4687 3894 2659 3747 627 3331 3669 4068 4186 3974 4046 3926 3649 4035 4205 4109 2933 3368 4067 3717 4486 4195 1817 3053 3392 3663 3520 2765 1607 2566 1495 2792 3068 3071 3867 2914 3613 3727 3940 3614 3485 3811 2594 705 3322 3620 3190 2743 3310 3523 3740 3709 3577 2739 2431 3403 3750 2660 3068 2209 1011 754 1317 1162 2302 2423 2999 2485 2294 1951 2236 2368 3272 4098 4521 3425 2376 3598 2177 4097 3214 2493 2311 2298 2935 3376 3292 3163 1301 1977 2432 4339 4270 4075 3456 4023 3243 3624 4509 4579 3761 4151 2832 2947 3784 4375 2802 3830 3831 2169 1529 3422 3922 4169 3005 4154 4318 2689 3129 3777 4773 5062 3487 2732 3389 4322 4363 1834 4990 3194 4066 3423 3333 3956 4916 5382 4569 4118 4911 5298 5847 6312 6192 4378 7836 5892 6153 6093 6230 6871 8362 3372 4996 5558 5102 5698 6133 5459 6235 6041 5936 6772 6436 6457 6460 6857 5169 5585 5918 4862 5409 6398 7460 7132 6370 6691 4367 6565 7290 6624 1027 3214 5633 6196 5026 6233 4220 6304 5572 5740 6169 6421 6296 6883 6359 6273 5728 4717 6572 7030 7429 6118 2843 5115 7424 7384 7639 8294 7129 4359 6073 5260 6770 6734 6536 6591 6043 5743 6855 7338 4127 8120 7641 6998 7001 7055 7494 7736 7498 6598 6664 4972 7421 7363 7665 7702 6978 5099 6825 6211 5905 5823 7458 6891 6779 7442 7335 6879 5463 5687 5531 6227 6660 7403 6241 6207 4840 4672 6569 6290 7264 7446 7499 6969 6031 6830 6786 5713 6591 5870 4459 7410 6966 7592 8173 6861 6904 6685 6597 7105 7216 7580 7261 7175 6824 5464 7013 7273 7534 7286 5786 6299 6544 6883 6784 7347 7605 7148 7865 4549 6530 7006 7375 7765 7582 6053 5255 6917 7040 7697 7713 7350 6140 5810 6034 6864 7112 6203 7504 5976 8227 7525 7767 7870 7804 8009 8714 7333 6869 4073 7591 7720 8167 8395 7907 7436 7538 7733 7393 7415 8555 6889 6778 4639 7572 7328 8156 7965 3510 5478 6392 7691 7570 7282 7109 6639 5875 7534 7461 7509 5424 8090 6824 7058 7466 7693 7359 7444 7852 4459 22 1096 5566 5986 5847 5138 5107 5259 5686 5035 5315 5992 6536 6852 6269 4094 5495 5445 5698 5629 4669 5499 5634 5146 2425 3910 2277 2424 5087 3959 5260 5323 5668 5191 4649 6234 6606 5729 5375 5008 5582 3228 5170 5501 5319 5532 5611 5047 3786 4585 5557 5267 4128 3623 1749 1787 920 1013 441 2114 3095 1341 1796 2729 

# Plots of the short and Long Term Forecasts  
t = 1:800
plot(t[670:731],daily_bike_data$Total_Users[670:731], type = 'l', main = "Short Term Forecast", xlim = c(670,745), xlab = "Time", ylab = "Total Users")
points(t[732:738],arma_stfore2$f, type = 'l', col = 'blue')
points(t[732:738],arma_stfore2$ll, type = 'l',lwd=2, lty = 2, col = 'red')
points(t[732:738],arma_stfore2$ul, type = 'l',lwd=2, lty = 2, col = 'red')

plot(t[670:731],daily_bike_data$Total_Users[670:731], type = 'l', main = "Long Term Forecast", xlim = c(670,795), xlab = "Time", ylab = "Total Users")
points(t[732:791],arma_ltfore2$f, type = 'l', col = 'blue')
points(t[732:791],arma_ltfore2$ll, type = 'l',lwd=2, lty = 2, col = 'red')
points(t[732:791],arma_ltfore2$ul, type = 'l',lwd=2, lty = 2, col = 'red')

Non-Seasonal ARIMA Model

# Check if the data could be stationary
adf.test(daily_bike_data$Total_Users) # p-value 0.7, data not likely stationary

    Augmented Dickey-Fuller Test

data:  daily_bike_data$Total_Users
Dickey-Fuller = -1.6351, Lag order = 9, p-value = 0.7327
alternative hypothesis: stationary

# Difference of 1
total_d1 = artrans.wge(daily_bike_data$Total_Users, phi.tr = c(1))

# Model the residuals
aic5.wge(total_d1, type = 'bic') # bic and aic pick p = 1 and q = 1

---------WORKING... PLEASE WAIT... 


Five Smallest Values of  bic 
    p    q        bic
    1    1   13.68620
    0    2   13.69304
    2    1   13.69387
    1    2   13.69455
    3    1   13.69895

est = est.arma.wge(total_d1, p = 1, q = 1)

  
  
Coefficients of AR polynomial:  
0.3591 

                           AR Factor Table 
Factor                 Roots                Abs Recip    System Freq 
1-0.3591B              2.7848               0.3591       0.0000
  
  
  
  
Coefficients of MA polynomial:  
0.8903 

                              MA FACTOR TABLE 
Factor                 Roots                Abs Recip    System Freq 
1-0.8903B              1.1232               0.8903       0.0000
  
  

plotts.sample.wge(est$res, arlimits = TRUE)$xbar # appears to be white noise

[1] -1.083662

ljung.wge(est$res) # FTR

Obs 0.01106095 -0.01226944 -0.04955624 -0.04487202 -0.01066982 0.09196727 0.01823558 0.01832273 -0.0280327 0.008467002 -0.03320097 -0.01648752 -0.04075165 0.07603663 0.06427303 -0.0260844 0.005665222 -0.03280932 -0.03354154 0.01664482 0.07094442 0.0320215 -0.0004189083 -0.006244533 

$test
[1] "Ljung-Box test"

$K
[1] 24

$chi.square
[1] 27.5971

$df
[1] 24

$pval
[1] 0.2773996

ljung.wge(est$res, K = 48) # Reject. Mixed evidence.

Obs 0.01106095 -0.01226944 -0.04955624 -0.04487202 -0.01066982 0.09196727 0.01823558 0.01832273 -0.0280327 0.008467002 -0.03320097 -0.01648752 -0.04075165 0.07603663 0.06427303 -0.0260844 0.005665222 -0.03280932 -0.03354154 0.01664482 0.07094442 0.0320215 -0.0004189083 -0.006244533 -0.03861073 0.04916367 0.04703067 0.06298134 0.1247115 -0.04713436 -0.03531116 -0.06145962 0.01091111 0.0188672 0.03310521 -0.006645202 0.05320788 -0.06603257 0.0242021 -0.03893266 0.05058829 0.02162102 0.02101459 -0.007107952 -0.05170156 0.002141853 0.02721173 0.01534891 

$test
[1] "Ljung-Box test"

$K
[1] 48

$chi.square
[1] 66.66045

$df
[1] 48

$pval
[1] 0.03852057

The final model is:

\[(1 - 0.3591B)(1 - B)X_t = (1 + 0.8903B)\alpha_t\]

# Generate realizations for comparison
arima_gen1 = gen.arima.wge(200, phi = est$phi, theta = est$theta, d = 1)

arima_gen2 = gen.arima.wge(200, phi = est$phi, theta = est$theta, d = 1)

arima_gen3 = gen.arima.wge(200, phi = est$phi, theta = est$theta, d = 1)

arima_gen4 = gen.arima.wge(200, phi = est$phi, theta = est$theta, d = 1)

plotts.sample.wge(arima_gen1)$xbar

[1] 7.377414

plotts.sample.wge(arima_gen2)$xbar

[1] -2.337345

plotts.sample.wge(arima_gen3)$xbar

[1] -2.396652

plotts.sample.wge(arima_gen4)$xbar # Similar behavior to original data

[1] -9.309329

# Compare Spectral Densities: 
sims = 20
SpecDen = parzen.wge(daily_bike_data$Total_Users, plot = "FALSE")
plot(SpecDen$freq,SpecDen$pzgram, type = "l", lwd = 6)

for( i in 1: sims)
{
   SpecDen2 = parzen.wge(gen.aruma.wge(length(daily_bike_data$Total_Users), d = 1, phi = est$phi, theta = est$theta, plot ="FALSE"), plot = "FALSE")
   lines(SpecDen2$freq,SpecDen2$pzgram, lwd = 2, col = "red")
}

# Compare ACFs:
sims = 20
ACF = acf(daily_bike_data$Total_Users, plot = "FALSE")
plot(ACF$lag ,ACF$acf , type = "l", lwd = 6)

for( i in 1: sims)
{
   ACF2 = acf(gen.aruma.wge(length(daily_bike_data$Total_Users), d = 1, phi = est$phi, theta = est$theta, plot ="FALSE"), plot = "FALSE")
   lines(ACF2$lag ,ACF2$acf, lwd = 2, col = "red")
}

# Short and Long Term Forecasts
fore_arima_st = fore.arima.wge(daily_bike_data$Total_Users, phi = est$phi, theta = est$theta, d = 1, n.ahead = 7, lastn = TRUE)

y.arma -184 548 213 38 6 -96 -551 -137 499 -58 -101 244 15 -173 -44 -204 -317 967 277 -384 -562 5 430 569 -1479 -75 736 -69 -2 405 -141 166 24 158 -703 618 89 -182 75 -67 208 -274 117 324 -98 300 360 452 -1292 177 -705 343 467 -110 -346 508 433 -956 405 283 -449 259 133 -1472 1267 261 -242 -1268 1354 155 285 -371 10 136 552 495 -122 -646 -394 626 -582 -256 345 286 -803 335 397 -889 149 542 25 997 -134 -1320 1013 333 -1670 984 440 453 -1314 128 1105 -141 -2331 2949 -315 -225 740 245 -2506 2353 155 -118 327 -528 186 537 717 -1961 1050 50 -1818 1800 175 106 -381 29 441 -621 682 -759 -696 1144 -595 165 -268 720 342 888 -1145 -386 218 486 -301 2 79 30 -690 -116 -8 994 344 30 -436 -358 285 -432 -486 671 380 -506 560 -129 289 -1413 1077 275 -375 -734 825 -328 283 201 211 103 -597 -60 577 290 -153 -243 -470 1394 -1378 -36 -37 -552 1296 -455 -795 172 84 742 454 385 -621 -844 83 -209 -548 -397 -102 321 234 750 66 -266 -544 629 -173 -36 579 -1271 1002 290 -572 -509 541 276 178 12 113 -755 -330 518 387 -31 -889 348 1038 -1318 885 1137 -765 -1588 1119 -3546 3219 300 570 -146 57 -388 -243 456 -1589 -641 -714 -154 1702 1801 -299 -333 50 22 -1126 1101 -249 -237 265 -898 711 443 -2400 3028 -413 -380 -510 -213 932 363 -2773 489 652 886 370 -61 220 424 102 -394 -554 -2147 497 731 1573 -176 -471 178 -2324 1771 109 4 73 -194 500 -793 -1235 1088 -3120 2704 338 399 118 -212 72 -120 -277 386 170 -96 -1176 435 699 -350 769 -291 -2378 1236 339 271 -143 -755 -1158 959 -1071 1297 276 3 796 -953 699 114 213 -326 -129 326 -1217 -1889 2617 298 -430 -447 567 213 217 -31 -132 -838 -308 972 347 -1090 408 -859 -1198 -257 563 -155 1140 121 576 -514 -191 -343 285 132 904 826 423 -1096 -1049 1222 -1421 1920 -883 -721 -182 -13 637 441 -84 -129 -1862 676 455 1907 -69 -195 -619 567 -780 381 885 70 -818 390 -1319 115 837 591 -1573 1028 1 -1662 -640 1893 500 247 -1164 1149 164 -1629 440 648 996 289 -1575 -755 657 933 41 -2529 3156 -1796 872 -643 -90 623 960 466 -813 -451 793 387 549 465 -120 -1814 3458 -1944 261 -60 137 641 1491 -4990 1624 562 -456 596 435 -674 776 -194 -105 836 -336 21 3 397 -1688 416 333 -1056 547 989 1062 -328 -762 321 -2324 2198 725 -666 -5597 2187 2419 563 -1170 1207 -2013 2084 -732 168 429 252 -125 587 -524 -86 -545 -1011 1855 458 399 -1311 -3275 2272 2309 -40 255 655 -1165 -2770 1714 -813 1510 -36 -198 55 -548 -300 1112 483 -3211 3993 -479 -643 3 54 439 242 -238 -900 66 -1692 2449 -58 302 37 -724 -1879 1726 -614 -306 -82 1635 -567 -112 663 -107 -456 -1416 224 -156 696 433 743 -1162 -34 -1367 -168 1897 -279 974 182 53 -530 -938 799 -44 -1073 878 -721 -1411 2951 -444 626 581 -1312 43 -219 -88 508 111 364 -319 -86 -351 -1360 1549 260 261 -248 -1500 513 245 339 -99 563 258 -457 717 -3316 1981 476 369 390 -183 -1529 -798 1662 123 657 16 -363 -1210 -330 224 830 248 -909 1301 -1528 2251 -702 242 103 -66 205 705 -1381 -464 -2796 3518 129 447 228 -488 -471 102 195 -340 22 1140 -1666 -111 -2139 2933 -244 828 -191 -4455 1968 914 1299 -121 -288 -173 -470 -764 1659 -73 48 -2085 2666 -1266 234 408 227 -334 85 408 -3393 -4437 1074 4470 420 -139 -709 -31 152 427 -651 280 677 544 316 -583 -2175 1401 -50 253 -69 -960 830 135 -488 -2721 1485 -1633 147 2663 -1128 1301 63 345 -477 -542 1585 372 -877 -354 -367 574 -2354 1942 331 -182 213 79 -564 -1261 799 972 -290 -1139 -505 -1874 38 -867 93 -572 1673 981 -1754 455 933 

fore_arima_lt = fore.arima.wge(daily_bike_data$Total_Users, phi = est$phi, theta = est$theta, d = 1, n.ahead = 60, lastn = TRUE)

y.arma -184 548 213 38 6 -96 -551 -137 499 -58 -101 244 15 -173 -44 -204 -317 967 277 -384 -562 5 430 569 -1479 -75 736 -69 -2 405 -141 166 24 158 -703 618 89 -182 75 -67 208 -274 117 324 -98 300 360 452 -1292 177 -705 343 467 -110 -346 508 433 -956 405 283 -449 259 133 -1472 1267 261 -242 -1268 1354 155 285 -371 10 136 552 495 -122 -646 -394 626 -582 -256 345 286 -803 335 397 -889 149 542 25 997 -134 -1320 1013 333 -1670 984 440 453 -1314 128 1105 -141 -2331 2949 -315 -225 740 245 -2506 2353 155 -118 327 -528 186 537 717 -1961 1050 50 -1818 1800 175 106 -381 29 441 -621 682 -759 -696 1144 -595 165 -268 720 342 888 -1145 -386 218 486 -301 2 79 30 -690 -116 -8 994 344 30 -436 -358 285 -432 -486 671 380 -506 560 -129 289 -1413 1077 275 -375 -734 825 -328 283 201 211 103 -597 -60 577 290 -153 -243 -470 1394 -1378 -36 -37 -552 1296 -455 -795 172 84 742 454 385 -621 -844 83 -209 -548 -397 -102 321 234 750 66 -266 -544 629 -173 -36 579 -1271 1002 290 -572 -509 541 276 178 12 113 -755 -330 518 387 -31 -889 348 1038 -1318 885 1137 -765 -1588 1119 -3546 3219 300 570 -146 57 -388 -243 456 -1589 -641 -714 -154 1702 1801 -299 -333 50 22 -1126 1101 -249 -237 265 -898 711 443 -2400 3028 -413 -380 -510 -213 932 363 -2773 489 652 886 370 -61 220 424 102 -394 -554 -2147 497 731 1573 -176 -471 178 -2324 1771 109 4 73 -194 500 -793 -1235 1088 -3120 2704 338 399 118 -212 72 -120 -277 386 170 -96 -1176 435 699 -350 769 -291 -2378 1236 339 271 -143 -755 -1158 959 -1071 1297 276 3 796 -953 699 114 213 -326 -129 326 -1217 -1889 2617 298 -430 -447 567 213 217 -31 -132 -838 -308 972 347 -1090 408 -859 -1198 -257 563 -155 1140 121 576 -514 -191 -343 285 132 904 826 423 -1096 -1049 1222 -1421 1920 -883 -721 -182 -13 637 441 -84 -129 -1862 676 455 1907 -69 -195 -619 567 -780 381 885 70 -818 390 -1319 115 837 591 -1573 1028 1 -1662 -640 1893 500 247 -1164 1149 164 -1629 440 648 996 289 -1575 -755 657 933 41 -2529 3156 -1796 872 -643 -90 623 960 466 -813 -451 793 387 549 465 -120 -1814 3458 -1944 261 -60 137 641 1491 -4990 1624 562 -456 596 435 -674 776 -194 -105 836 -336 21 3 397 -1688 416 333 -1056 547 989 1062 -328 -762 321 -2324 2198 725 -666 -5597 2187 2419 563 -1170 1207 -2013 2084 -732 168 429 252 -125 587 -524 -86 -545 -1011 1855 458 399 -1311 -3275 2272 2309 -40 255 655 -1165 -2770 1714 -813 1510 -36 -198 55 -548 -300 1112 483 -3211 3993 -479 -643 3 54 439 242 -238 -900 66 -1692 2449 -58 302 37 -724 -1879 1726 -614 -306 -82 1635 -567 -112 663 -107 -456 -1416 224 -156 696 433 743 -1162 -34 -1367 -168 1897 -279 974 182 53 -530 -938 799 -44 -1073 878 -721 -1411 2951 -444 626 581 -1312 43 -219 -88 508 111 364 -319 -86 -351 -1360 1549 260 261 -248 -1500 513 245 339 -99 563 258 -457 717 -3316 1981 476 369 390 -183 -1529 -798 1662 123 657 16 -363 -1210 -330 224 830 248 -909 1301 -1528 2251 -702 242 103 -66 205 705 -1381 -464 -2796 3518 129 447 228 -488 -471 102 195 -340 22 1140 -1666 -111 -2139 2933 -244 828 -191 -4455 1968 914 1299 -121 -288 -173 -470 -764 1659 -73 48 -2085 2666 -1266 234 408 227 -334 85 408 -3393 -4437 1074 4470 420 -139 -709 -31 152 427 -651 280 677 544 316 -583 -2175 1401 -50 253 -69 -960 830 135 -488 -2721 1485 -1633 147 2663 -1128 1301 63 345 -477 -542 1585 372 -877 -354 -367 574 -2354 1942 331 -182 213 79 -564 -1261 799 972 -290 -1139 -505 -1874 38 -867 93 -572 1673 981 -1754 455 933 

# Plot Forecasts and CI
t = 1:length(daily_bike_data$Total_Users)
plot(t[720:731],daily_bike_data$Total_Users[720:731], type = 'l', xlab = "Time", ylab = "Total Users")
points(t[725:731], fore_arima_st$f, type="l", lwd=2, lty = 2, col = 'blue')

plot(t[670:731],daily_bike_data$Total_Users[670:731], type = 'l', xlab = "Time", ylab = "Total Users")
points(t[672:731], fore_arima_lt$f, type="l", lwd=2, lty = 2,col = 'blue')

# ASE 
arima_stASE = mean((daily_bike_data$Total_Users[725:731]-fore_arima_st$f)^2)
arima_ltASE = mean((daily_bike_data$Total_Users[672:731]-fore_arima_lt$f)^2)
arima_stASE

[1] 3230238

arima_ltASE

[1] 3930824

# Rolling Window RMSE
# RW-RMSE commented out due to obscene amount of unsupressable output
# arima_strwRMSE = roll.win.rmse.wge(daily_bike_data$Total_Users, horizon = 7, phi = est$phi, theta = est$theta, d = 1)$rwRMSE
# arima_ltrwRMSE = roll.win.rmse.wge(daily_bike_data$Total_Users, horizon = 60, phi = est$phi, theta = est$theta, d = 1)$rwRMSE
arima_strwRMSE = 1237.393
arima_ltrwRMSE = 1503.197

# Plots of the short and Long Term Forecasts  
fore_arima_st_2 = fore.arima.wge(daily_bike_data$Total_Users, phi = est$phi, theta = est$theta, d = 1, n.ahead = 7)

y.arma -184 548 213 38 6 -96 -551 -137 499 -58 -101 244 15 -173 -44 -204 -317 967 277 -384 -562 5 430 569 -1479 -75 736 -69 -2 405 -141 166 24 158 -703 618 89 -182 75 -67 208 -274 117 324 -98 300 360 452 -1292 177 -705 343 467 -110 -346 508 433 -956 405 283 -449 259 133 -1472 1267 261 -242 -1268 1354 155 285 -371 10 136 552 495 -122 -646 -394 626 -582 -256 345 286 -803 335 397 -889 149 542 25 997 -134 -1320 1013 333 -1670 984 440 453 -1314 128 1105 -141 -2331 2949 -315 -225 740 245 -2506 2353 155 -118 327 -528 186 537 717 -1961 1050 50 -1818 1800 175 106 -381 29 441 -621 682 -759 -696 1144 -595 165 -268 720 342 888 -1145 -386 218 486 -301 2 79 30 -690 -116 -8 994 344 30 -436 -358 285 -432 -486 671 380 -506 560 -129 289 -1413 1077 275 -375 -734 825 -328 283 201 211 103 -597 -60 577 290 -153 -243 -470 1394 -1378 -36 -37 -552 1296 -455 -795 172 84 742 454 385 -621 -844 83 -209 -548 -397 -102 321 234 750 66 -266 -544 629 -173 -36 579 -1271 1002 290 -572 -509 541 276 178 12 113 -755 -330 518 387 -31 -889 348 1038 -1318 885 1137 -765 -1588 1119 -3546 3219 300 570 -146 57 -388 -243 456 -1589 -641 -714 -154 1702 1801 -299 -333 50 22 -1126 1101 -249 -237 265 -898 711 443 -2400 3028 -413 -380 -510 -213 932 363 -2773 489 652 886 370 -61 220 424 102 -394 -554 -2147 497 731 1573 -176 -471 178 -2324 1771 109 4 73 -194 500 -793 -1235 1088 -3120 2704 338 399 118 -212 72 -120 -277 386 170 -96 -1176 435 699 -350 769 -291 -2378 1236 339 271 -143 -755 -1158 959 -1071 1297 276 3 796 -953 699 114 213 -326 -129 326 -1217 -1889 2617 298 -430 -447 567 213 217 -31 -132 -838 -308 972 347 -1090 408 -859 -1198 -257 563 -155 1140 121 576 -514 -191 -343 285 132 904 826 423 -1096 -1049 1222 -1421 1920 -883 -721 -182 -13 637 441 -84 -129 -1862 676 455 1907 -69 -195 -619 567 -780 381 885 70 -818 390 -1319 115 837 591 -1573 1028 1 -1662 -640 1893 500 247 -1164 1149 164 -1629 440 648 996 289 -1575 -755 657 933 41 -2529 3156 -1796 872 -643 -90 623 960 466 -813 -451 793 387 549 465 -120 -1814 3458 -1944 261 -60 137 641 1491 -4990 1624 562 -456 596 435 -674 776 -194 -105 836 -336 21 3 397 -1688 416 333 -1056 547 989 1062 -328 -762 321 -2324 2198 725 -666 -5597 2187 2419 563 -1170 1207 -2013 2084 -732 168 429 252 -125 587 -524 -86 -545 -1011 1855 458 399 -1311 -3275 2272 2309 -40 255 655 -1165 -2770 1714 -813 1510 -36 -198 55 -548 -300 1112 483 -3211 3993 -479 -643 3 54 439 242 -238 -900 66 -1692 2449 -58 302 37 -724 -1879 1726 -614 -306 -82 1635 -567 -112 663 -107 -456 -1416 224 -156 696 433 743 -1162 -34 -1367 -168 1897 -279 974 182 53 -530 -938 799 -44 -1073 878 -721 -1411 2951 -444 626 581 -1312 43 -219 -88 508 111 364 -319 -86 -351 -1360 1549 260 261 -248 -1500 513 245 339 -99 563 258 -457 717 -3316 1981 476 369 390 -183 -1529 -798 1662 123 657 16 -363 -1210 -330 224 830 248 -909 1301 -1528 2251 -702 242 103 -66 205 705 -1381 -464 -2796 3518 129 447 228 -488 -471 102 195 -340 22 1140 -1666 -111 -2139 2933 -244 828 -191 -4455 1968 914 1299 -121 -288 -173 -470 -764 1659 -73 48 -2085 2666 -1266 234 408 227 -334 85 408 -3393 -4437 1074 4470 420 -139 -709 -31 152 427 -651 280 677 544 316 -583 -2175 1401 -50 253 -69 -960 830 135 -488 -2721 1485 -1633 147 2663 -1128 1301 63 345 -477 -542 1585 372 -877 -354 -367 574 -2354 1942 331 -182 213 79 -564 -1261 799 972 -290 -1139 -505 -1874 38 -867 93 -572 1673 981 -1754 455 933 

fore_arima_lt_2 = fore.arima.wge(daily_bike_data$Total_Users, phi = est$phi, theta = est$theta, d = 1, n.ahead = 60)

y.arma -184 548 213 38 6 -96 -551 -137 499 -58 -101 244 15 -173 -44 -204 -317 967 277 -384 -562 5 430 569 -1479 -75 736 -69 -2 405 -141 166 24 158 -703 618 89 -182 75 -67 208 -274 117 324 -98 300 360 452 -1292 177 -705 343 467 -110 -346 508 433 -956 405 283 -449 259 133 -1472 1267 261 -242 -1268 1354 155 285 -371 10 136 552 495 -122 -646 -394 626 -582 -256 345 286 -803 335 397 -889 149 542 25 997 -134 -1320 1013 333 -1670 984 440 453 -1314 128 1105 -141 -2331 2949 -315 -225 740 245 -2506 2353 155 -118 327 -528 186 537 717 -1961 1050 50 -1818 1800 175 106 -381 29 441 -621 682 -759 -696 1144 -595 165 -268 720 342 888 -1145 -386 218 486 -301 2 79 30 -690 -116 -8 994 344 30 -436 -358 285 -432 -486 671 380 -506 560 -129 289 -1413 1077 275 -375 -734 825 -328 283 201 211 103 -597 -60 577 290 -153 -243 -470 1394 -1378 -36 -37 -552 1296 -455 -795 172 84 742 454 385 -621 -844 83 -209 -548 -397 -102 321 234 750 66 -266 -544 629 -173 -36 579 -1271 1002 290 -572 -509 541 276 178 12 113 -755 -330 518 387 -31 -889 348 1038 -1318 885 1137 -765 -1588 1119 -3546 3219 300 570 -146 57 -388 -243 456 -1589 -641 -714 -154 1702 1801 -299 -333 50 22 -1126 1101 -249 -237 265 -898 711 443 -2400 3028 -413 -380 -510 -213 932 363 -2773 489 652 886 370 -61 220 424 102 -394 -554 -2147 497 731 1573 -176 -471 178 -2324 1771 109 4 73 -194 500 -793 -1235 1088 -3120 2704 338 399 118 -212 72 -120 -277 386 170 -96 -1176 435 699 -350 769 -291 -2378 1236 339 271 -143 -755 -1158 959 -1071 1297 276 3 796 -953 699 114 213 -326 -129 326 -1217 -1889 2617 298 -430 -447 567 213 217 -31 -132 -838 -308 972 347 -1090 408 -859 -1198 -257 563 -155 1140 121 576 -514 -191 -343 285 132 904 826 423 -1096 -1049 1222 -1421 1920 -883 -721 -182 -13 637 441 -84 -129 -1862 676 455 1907 -69 -195 -619 567 -780 381 885 70 -818 390 -1319 115 837 591 -1573 1028 1 -1662 -640 1893 500 247 -1164 1149 164 -1629 440 648 996 289 -1575 -755 657 933 41 -2529 3156 -1796 872 -643 -90 623 960 466 -813 -451 793 387 549 465 -120 -1814 3458 -1944 261 -60 137 641 1491 -4990 1624 562 -456 596 435 -674 776 -194 -105 836 -336 21 3 397 -1688 416 333 -1056 547 989 1062 -328 -762 321 -2324 2198 725 -666 -5597 2187 2419 563 -1170 1207 -2013 2084 -732 168 429 252 -125 587 -524 -86 -545 -1011 1855 458 399 -1311 -3275 2272 2309 -40 255 655 -1165 -2770 1714 -813 1510 -36 -198 55 -548 -300 1112 483 -3211 3993 -479 -643 3 54 439 242 -238 -900 66 -1692 2449 -58 302 37 -724 -1879 1726 -614 -306 -82 1635 -567 -112 663 -107 -456 -1416 224 -156 696 433 743 -1162 -34 -1367 -168 1897 -279 974 182 53 -530 -938 799 -44 -1073 878 -721 -1411 2951 -444 626 581 -1312 43 -219 -88 508 111 364 -319 -86 -351 -1360 1549 260 261 -248 -1500 513 245 339 -99 563 258 -457 717 -3316 1981 476 369 390 -183 -1529 -798 1662 123 657 16 -363 -1210 -330 224 830 248 -909 1301 -1528 2251 -702 242 103 -66 205 705 -1381 -464 -2796 3518 129 447 228 -488 -471 102 195 -340 22 1140 -1666 -111 -2139 2933 -244 828 -191 -4455 1968 914 1299 -121 -288 -173 -470 -764 1659 -73 48 -2085 2666 -1266 234 408 227 -334 85 408 -3393 -4437 1074 4470 420 -139 -709 -31 152 427 -651 280 677 544 316 -583 -2175 1401 -50 253 -69 -960 830 135 -488 -2721 1485 -1633 147 2663 -1128 1301 63 345 -477 -542 1585 372 -877 -354 -367 574 -2354 1942 331 -182 213 79 -564 -1261 799 972 -290 -1139 -505 -1874 38 -867 93 -572 1673 981 -1754 455 933 

t = 1:800
plot(t[670:731],daily_bike_data$Total_Users[670:731], type = 'l', main = "Short Term Forecast", xlim = c(670,795), xlab = "Time", ylab = "Total Users")
points(t[732:738],fore_arima_st_2$f, type = 'l', col = 'blue')
points(t[732:738],fore_arima_st_2$ll, type = 'l',lwd=2, lty = 2, col = 'red')
points(t[732:738],fore_arima_st_2$ul, type = 'l',lwd=2, lty = 2, col = 'red')

plot(t[670:731],daily_bike_data$Total_Users[670:731], type = 'l', main = "Long Term Forecast", xlim = c(670,795), xlab = "Time", ylab = "Total Users")
points(t[732:791],fore_arima_lt_2$f, type = 'l', col = 'blue')
points(t[732:791],fore_arima_lt_2$ll, type = 'l',lwd=2, lty = 2, col = 'red')
points(t[732:791],fore_arima_lt_2$ul, type = 'l',lwd=2, lty = 2, col = 'red')

1. The models in factored form or at least separate the stationary and non- stationary factors with standard deviation or variance of the white noise.
2. AIC
3. ASE (short and long term forecasts)
4. Rolling Window RMSE (short and long term forecasts)
5. At least 10 superimposed spectral densities from 10 generated realizations like we did in Unit 11. Use these to help choose between the at least two candidate univariate models.
6. Visualization of Forecasts for both the short- and long-term Horizons.
7. Be sure and include confidence intervals when possible (I don’t have code for confidence intervals from MLP models at the moment… but that would be a good thing to work on!  )

Multivariate: At least one multivariate model (VAR or MLR with Correlated Errors)

1. Include an ASE (rolling window is not yet available in multivariate models)

1. Short Horizon (you pick the length.. could be one step ahead)
2. Long Horizon (you pick … just must be longer than the short horizon.)

2. Describe the explanatory variable(s) used in the model and why you felt they were significant / important.
3. Visualization of Forecasts for both the short- and long-Horizons.
4. Be sure and include confidence intervals if using VAR …

ccf(daily_bike_data$Total_Users,daily_bike_data$Humidity) # lag of 4 

daily_bike_data$Humidity_lag = dplyr::lag(daily_bike_data$Humidity,4)

# Short Term Prediction Fit
fit1 = lm(Total_Users~Humidity_lag + Temperature + Day_of_the_Week + Wind_Speed, data = daily_bike_data[1:724,])

plotts.sample.wge(fit1$residuals)$xbar

[1] 1.013076e-12

aic5.wge(fit1$residuals, type = 'bic')

---------WORKING... PLEASE WAIT... 


Five Smallest Values of  bic 
    p    q        bic
    2    1   13.55385
    3    1   13.56279
    2    2   13.56438
    4    1   13.56665
    3    2   13.56898

mlr1 = arima(daily_bike_data$Total_Users[1:724], order = c(2,0,1),xreg = cbind(daily_bike_data$Humidity_lag[1:724], daily_bike_data$Temperature[1:724], daily_bike_data$Day_of_the_Week[1:724], daily_bike_data$Wind_Speed[1:724]))


plotts.wge(mlr1$residuals) # looks random

acf(mlr1$residuals[-(1:5)]) # none of the acfs out of bounds 

ljung.wge(mlr1$residuals) # greater than 0.05

Obs -0.003328161 0.02683572 -0.05409301 -0.03551451 -0.01589091 0.0690144 -0.01861919 0.01455203 -0.02561412 0.02715559 -0.01385339 -0.00440597 -0.04661651 0.02478028 0.06654187 -0.02930981 -0.001301774 -0.03017952 -0.02837183 0.005013895 0.03371453 -0.005350352 -0.01574927 -0.01508306 

$test
[1] "Ljung-Box test"

$K
[1] 24

$chi.square
[1] 17.35619

$df
[1] 24

$pval
[1] 0.8330782

ljung.wge(mlr1$residuals, K =48)

Obs -0.003328161 0.02683572 -0.05409301 -0.03551451 -0.01589091 0.0690144 -0.01861919 0.01455203 -0.02561412 0.02715559 -0.01385339 -0.00440597 -0.04661651 0.02478028 0.06654187 -0.02930981 -0.001301774 -0.03017952 -0.02837183 0.005013895 0.03371453 -0.005350352 -0.01574927 -0.01508306 -0.03218184 0.04856411 0.05036623 0.0444878 0.1127002 -0.05009994 -0.01585031 -0.04786606 0.01625296 0.0104355 -0.008181569 -0.009193269 0.0608361 -0.06900966 0.03732035 -0.03629212 0.04561681 -0.02945508 -0.0418864 -0.03425085 -0.0354142 0.0225395 0.02883237 -0.01139502 

$test
[1] "Ljung-Box test"

$K
[1] 48

$chi.square
[1] 52.35977

$df
[1] 48

$pval
[1] 0.3086164

AIC(fit1)

[1] 12561.86

mlr_st_pred = predict(mlr1, newxreg = data.frame(daily_bike_data$Humidity_lag[725:731], daily_bike_data$Temperature[725:731], daily_bike_data$Day_of_the_Week[725:731], daily_bike_data$Wind_Speed[725:731]), n.ahead = 7, lastn= TRUE)

plot(seq(1,731,1),daily_bike_data$Total_Users,type = 'l',xlim = c(720,731))
points(seq(725,731,1),mlr_st_pred$pred,type = 'b', pch = 15)

mlr_st_ASE= mean((daily_bike_data$Total_Users[725:731] - mlr_st_pred$pred)^2)

mlr_st_ASE

[1] 2711048

# Long Term Prediction Fit
fit2 = lm(Total_Users~Humidity_lag + Temperature + Day_of_the_Week + Wind_Speed, data = daily_bike_data[1:671,])


plotts.sample.wge(fit2$residuals)$xbar

[1] -3.858876e-13

aic5.wge(fit2$residuals, type = 'bic')

---------WORKING... PLEASE WAIT... 


Five Smallest Values of  bic 
    p    q        bic
    2    1   13.56183
    3    1   13.57159
    2    2   13.57250
    1    2   13.57421
    4    1   13.57535

mlr2 = arima(daily_bike_data$Total_Users[1:671], order = c(2,0,1),xreg = cbind(daily_bike_data$Humidity_lag[1:671], daily_bike_data$Temperature[1:671], daily_bike_data$Day_of_the_Week[1:671], daily_bike_data$Wind_Speed[1:671]))

plotts.wge(mlr2$residuals) # looks random

acf(mlr2$residuals[-(1:5)]) # only 1/20 acfs out of bounds 

ljung.wge(mlr2$residuals) # greater than 0.05

Obs 0.0003510163 0.01039135 -0.06274605 -0.03838613 -0.0205847 0.07748063 -0.02617554 0.01534898 -0.02698541 0.03796171 0.008799756 0.01194111 -0.02763382 0.0197127 0.03767062 -0.0178001 -0.00649076 -0.01578965 -0.02668076 0.0120219 0.04359331 0.0002381477 -0.03267347 -0.05278786 

$test
[1] "Ljung-Box test"

$K
[1] 24

$chi.square
[1] 17.14497

$df
[1] 24

$pval
[1] 0.8424133

ljung.wge(mlr2$residuals, K =48)

Obs 0.0003510163 0.01039135 -0.06274605 -0.03838613 -0.0205847 0.07748063 -0.02617554 0.01534898 -0.02698541 0.03796171 0.008799756 0.01194111 -0.02763382 0.0197127 0.03767062 -0.0178001 -0.00649076 -0.01578965 -0.02668076 0.0120219 0.04359331 0.0002381477 -0.03267347 -0.05278786 -0.06339837 0.03538026 0.03279478 0.04666914 0.1080521 -0.06745314 -0.02263113 -0.07478221 0.01769991 -0.01268407 0.02269951 0.00101695 0.05854347 -0.06091242 0.03518144 -0.04240984 0.02440157 -0.02882236 -0.01663029 -0.02920806 -0.01599492 0.01278897 0.01494871 -0.03382208 

$test
[1] "Ljung-Box test"

$K
[1] 48

$chi.square
[1] 49.93849

$df
[1] 48

$pval
[1] 0.3962261

mlr_lt_pred = predict(mlr2, newxreg = data.frame(daily_bike_data$Humidity_lag[672:731], daily_bike_data$Temperature[672:731], daily_bike_data$Day_of_the_Week[672:731], daily_bike_data$Wind_Speed[672:731]), n.ahead = 60, lastn= TRUE)

plot(seq(1,731,1),daily_bike_data$Total_Users,type = 'l',xlim = c(670,731))
points(seq(672,731,1),mlr_lt_pred$pred,type = 'l', pch = 15,col = 'blue',lwd=2, lty = 2)

mlr_lt_ASE= mean((daily_bike_data$Total_Users[672:731] - mlr_lt_pred$pred)^2)

mlr_lt_ASE

[1] 2215232

# Forecasting The 4 Exogenous Variables 

parzen.wge(daily_bike_data$Humidity, trunc = 300)

$freq
  [1] 0.001367989 0.002735978 0.004103967 0.005471956 0.006839945 0.008207934
  [7] 0.009575923 0.010943912 0.012311902 0.013679891 0.015047880 0.016415869
 [13] 0.017783858 0.019151847 0.020519836 0.021887825 0.023255814 0.024623803
 [19] 0.025991792 0.027359781 0.028727770 0.030095759 0.031463748 0.032831737
 [25] 0.034199726 0.035567715 0.036935705 0.038303694 0.039671683 0.041039672
 [31] 0.042407661 0.043775650 0.045143639 0.046511628 0.047879617 0.049247606
 [37] 0.050615595 0.051983584 0.053351573 0.054719562 0.056087551 0.057455540
 [43] 0.058823529 0.060191518 0.061559508 0.062927497 0.064295486 0.065663475
 [49] 0.067031464 0.068399453 0.069767442 0.071135431 0.072503420 0.073871409
 [55] 0.075239398 0.076607387 0.077975376 0.079343365 0.080711354 0.082079343
 [61] 0.083447332 0.084815321 0.086183311 0.087551300 0.088919289 0.090287278
 [67] 0.091655267 0.093023256 0.094391245 0.095759234 0.097127223 0.098495212
 [73] 0.099863201 0.101231190 0.102599179 0.103967168 0.105335157 0.106703146
 [79] 0.108071135 0.109439124 0.110807114 0.112175103 0.113543092 0.114911081
 [85] 0.116279070 0.117647059 0.119015048 0.120383037 0.121751026 0.123119015
 [91] 0.124487004 0.125854993 0.127222982 0.128590971 0.129958960 0.131326949
 [97] 0.132694938 0.134062927 0.135430917 0.136798906 0.138166895 0.139534884
[103] 0.140902873 0.142270862 0.143638851 0.145006840 0.146374829 0.147742818
[109] 0.149110807 0.150478796 0.151846785 0.153214774 0.154582763 0.155950752
[115] 0.157318741 0.158686731 0.160054720 0.161422709 0.162790698 0.164158687
[121] 0.165526676 0.166894665 0.168262654 0.169630643 0.170998632 0.172366621
[127] 0.173734610 0.175102599 0.176470588 0.177838577 0.179206566 0.180574555
[133] 0.181942544 0.183310534 0.184678523 0.186046512 0.187414501 0.188782490
[139] 0.190150479 0.191518468 0.192886457 0.194254446 0.195622435 0.196990424
[145] 0.198358413 0.199726402 0.201094391 0.202462380 0.203830369 0.205198358
[151] 0.206566347 0.207934337 0.209302326 0.210670315 0.212038304 0.213406293
[157] 0.214774282 0.216142271 0.217510260 0.218878249 0.220246238 0.221614227
[163] 0.222982216 0.224350205 0.225718194 0.227086183 0.228454172 0.229822161
[169] 0.231190150 0.232558140 0.233926129 0.235294118 0.236662107 0.238030096
[175] 0.239398085 0.240766074 0.242134063 0.243502052 0.244870041 0.246238030
[181] 0.247606019 0.248974008 0.250341997 0.251709986 0.253077975 0.254445964
[187] 0.255813953 0.257181943 0.258549932 0.259917921 0.261285910 0.262653899
[193] 0.264021888 0.265389877 0.266757866 0.268125855 0.269493844 0.270861833
[199] 0.272229822 0.273597811 0.274965800 0.276333789 0.277701778 0.279069767
[205] 0.280437756 0.281805746 0.283173735 0.284541724 0.285909713 0.287277702
[211] 0.288645691 0.290013680 0.291381669 0.292749658 0.294117647 0.295485636
[217] 0.296853625 0.298221614 0.299589603 0.300957592 0.302325581 0.303693570
[223] 0.305061560 0.306429549 0.307797538 0.309165527 0.310533516 0.311901505
[229] 0.313269494 0.314637483 0.316005472 0.317373461 0.318741450 0.320109439
[235] 0.321477428 0.322845417 0.324213406 0.325581395 0.326949384 0.328317373
[241] 0.329685363 0.331053352 0.332421341 0.333789330 0.335157319 0.336525308
[247] 0.337893297 0.339261286 0.340629275 0.341997264 0.343365253 0.344733242
[253] 0.346101231 0.347469220 0.348837209 0.350205198 0.351573187 0.352941176
[259] 0.354309166 0.355677155 0.357045144 0.358413133 0.359781122 0.361149111
[265] 0.362517100 0.363885089 0.365253078 0.366621067 0.367989056 0.369357045
[271] 0.370725034 0.372093023 0.373461012 0.374829001 0.376196990 0.377564979
[277] 0.378932969 0.380300958 0.381668947 0.383036936 0.384404925 0.385772914
[283] 0.387140903 0.388508892 0.389876881 0.391244870 0.392612859 0.393980848
[289] 0.395348837 0.396716826 0.398084815 0.399452804 0.400820793 0.402188782
[295] 0.403556772 0.404924761 0.406292750 0.407660739 0.409028728 0.410396717
[301] 0.411764706 0.413132695 0.414500684 0.415868673 0.417236662 0.418604651
[307] 0.419972640 0.421340629 0.422708618 0.424076607 0.425444596 0.426812585
[313] 0.428180575 0.429548564 0.430916553 0.432284542 0.433652531 0.435020520
[319] 0.436388509 0.437756498 0.439124487 0.440492476 0.441860465 0.443228454
[325] 0.444596443 0.445964432 0.447332421 0.448700410 0.450068399 0.451436389
[331] 0.452804378 0.454172367 0.455540356 0.456908345 0.458276334 0.459644323
[337] 0.461012312 0.462380301 0.463748290 0.465116279 0.466484268 0.467852257
[343] 0.469220246 0.470588235 0.471956224 0.473324213 0.474692202 0.476060192
[349] 0.477428181 0.478796170 0.480164159 0.481532148 0.482900137 0.484268126
[355] 0.485636115 0.487004104 0.488372093 0.489740082 0.491108071 0.492476060
[361] 0.493844049 0.495212038 0.496580027 0.497948016 0.499316005

$pzgram
  [1]   8.594937115   9.040416537   8.744514441   8.203526707   7.691930774
  [6]   6.657928472   4.987353411   3.779066540   3.822037161   4.117778835
 [11]   4.080305573   3.900108803   3.650840883   3.286363599   3.166227809
 [16]   3.560062953   4.148542595   4.679436500   5.036207992   5.022028359
 [21]   4.618223586   4.095094448   3.752299534   3.878431853   4.495536832
 [26]   4.891636770   4.321651847   2.586892917   0.287683027  -0.967095231
 [31]  -0.154801125   1.779184068   3.329748243   3.728816431   3.008381705
 [36]   2.062470139   2.040867620   2.344850907   1.972943986   1.507444276
 [41]   2.392616997   3.591728656   3.645580543   2.546763564   1.397529938
 [46]   1.555075492   2.889476545   4.113456734   4.343448702   3.638212161
 [51]   2.760820859   2.177467720   1.847006340   1.845920773   1.768787742
 [56]   1.714232294   2.481054630   3.209449345   2.727055649   1.037292802
 [61]  -0.306982271   0.910333159   3.169372683   4.473565968   4.303055925
 [66]   2.680848635   0.091916698  -1.701511677  -1.345663688  -0.677340531
 [71]  -0.258598841   0.643100195   1.466256774   1.467894896   1.344551184
 [76]   1.964176457   2.470124265   2.234811882   1.863764220   2.114591700
 [81]   2.736897470   3.270334849   3.616146386   3.732490891   3.475900681
 [86]   2.849220489   2.209104569   1.964126712   2.219521464   2.699346344
 [91]   2.848076374   2.379471533   1.513906451   0.629701396   0.009238708
 [96]   0.104475547   0.934720049   1.812331108   2.350356535   2.594180496
[101]   2.643415190   2.508294240   2.204072185   1.716818077   1.028243611
[106]   0.928492387   2.377011093   3.939163313   4.265217284   3.168610925
[111]   1.305626815   0.192266404   0.045603454  -0.338900123  -0.532965042
[116]   0.706702843   2.088137002   2.216329645   0.896198496  -1.163548677
[121]  -2.237262376  -2.070972288  -1.686852188  -0.613200098   0.997570369
[126]   2.061895054   2.658629325   3.542627574   4.271819673   3.804808020
[131]   1.791439737  -0.555095973  -0.300488817   1.136282172   1.824979820
[136]   1.820522589   1.573178989   1.200340261   0.548505678  -0.375932456
[141]  -1.592254097  -2.915901616  -2.866964199  -1.257838745  -0.023035779
[146]   0.088847682  -0.775589476  -1.926204672  -2.647717546  -3.191826847
[151]  -3.980150578  -4.849247762  -5.414509158  -5.136595392  -4.222254865
[156]  -3.807784611  -4.531537440  -6.268987448  -7.749911249  -6.931382998
[161]  -4.986319779  -3.802454255  -3.734824180  -4.437747474  -5.440950339
[166]  -6.767443015  -8.753589107 -10.690095112 -10.130857997  -8.206825472
[171]  -7.008707379  -6.299876627  -5.303776767  -4.050730748  -2.905882278
[176]  -2.177646549  -2.202332988  -2.919404859  -3.589023219  -3.877204822
[181]  -4.496832829  -5.337874309  -5.005566634  -3.904434399  -3.435418299
[186]  -3.458708360  -2.582937024  -0.689832700   0.821690330   1.319743310
[191]   0.917104109   0.153817485  -0.491831027  -1.220225684  -2.360923984
[196]  -3.735522536  -5.079883979  -6.297011868  -6.694749698  -6.097206384
[201]  -5.430234465  -4.821290729  -4.103499777  -3.622032953  -3.400320177
[206]  -2.856772227  -2.019265279  -1.632698722  -2.052250520  -3.067996584
[211]  -4.206657227  -5.071861611  -5.327262212  -5.002412420  -4.575575332
[216]  -3.932278065  -2.871792959  -2.098864806  -2.192884738  -3.040045898
[221]  -4.260774524  -5.646072662  -6.198172847  -4.768791684  -3.083440704
[226]  -2.387152874  -2.706874167  -3.490975568  -3.247508272  -1.490320235
[231]   0.078821757   0.647391254   0.364650864  -0.368074036  -1.296252158
[236]  -2.441149237  -4.030661342  -6.072433149  -7.233711019  -6.447528473
[241]  -5.048214544  -3.619022542  -2.603018471  -2.475305790  -2.888148037
[246]  -2.876880004  -2.533773036  -2.672188570  -3.384193293  -4.107360810
[251]  -4.263565915  -4.113401271  -4.448918753  -5.626111556  -7.203996858
[256]  -7.991906677  -7.517145337  -6.785299581  -6.459353621  -6.370932453
[261]  -6.298239645  -6.364846354  -6.408168437  -6.048227736  -5.377868812
[266]  -4.660455274  -4.176770101  -4.189093037  -4.619762727  -5.211131228
[271]  -5.847187690  -6.145265347  -5.761076297  -5.354122413  -5.563215444
[276]  -6.303538852  -7.072500251  -7.467273026  -7.351576861  -6.614122580
[281]  -5.372585251  -4.068034813  -2.949534588  -1.978606877  -1.308381743
[286]  -1.384066802  -2.523045252  -4.514135926  -6.251465288  -6.818185127
[291]  -6.832798720  -6.513652198  -5.431946583  -3.740611314  -2.160250438
[296]  -1.343691745  -1.581349923  -2.588984486  -3.443699275  -3.842036150
[301]  -4.605381183  -5.909092303  -6.743767149  -6.537929102  -6.077095508
[306]  -5.859431994  -5.906986337  -6.174849737  -6.483716974  -6.402675775
[311]  -5.805590281  -5.227775087  -5.080566766  -5.256930182  -5.570143348
[316]  -6.126470801  -6.799703538  -6.697849566  -5.301495371  -3.467478747
[321]  -2.066653629  -1.487221047  -1.901202999  -3.337891643  -5.390581745
[326]  -6.904405556  -7.359707930  -7.240370242  -6.443563030  -5.458318602
[331]  -5.235776333  -6.173058909  -7.975583726  -9.470520965 -10.016423129
[336] -10.446345364 -10.190023303  -8.384834604  -6.616312467  -5.925647185
[341]  -6.263090822  -7.042979212  -7.438112689  -7.129853023  -6.543039365
[346]  -6.186880309  -6.214647785  -6.394673536  -6.538363185  -6.541064653
[351]  -5.847491815  -4.582458449  -3.845508016  -4.162060413  -5.020303748
[356]  -4.964952712  -3.998841526  -3.673752036  -4.639828255  -6.381075286
[361]  -7.067875372  -6.202672325  -5.265599723  -4.786713441  -4.642773819

humdiff = artrans.wge(daily_bike_data$Humidity, phi.tr = c(rep(0,364),1))

aic5.wge(humdiff, type = 'aic')

---------WORKING... PLEASE WAIT... 


Five Smallest Values of  aic 
    p    q        aic
    2    2   5.695175
    3    2   5.698350
    1    0   5.701318
    4    2   5.702775
    2    0   5.703852

hum = est.arma.wge(humdiff, p = 2, q = 2)

  
  
Coefficients of AR polynomial:  
-0.5883 0.3890 

                           AR Factor Table 
Factor                 Roots                Abs Recip    System Freq 
1+0.9837B             -1.0165               0.9837       0.5000
1-0.3954B              2.5289               0.3954       0.0000
  
  
  
  
Coefficients of MA polynomial:  
-1.0977 -0.1277 

                              MA FACTOR TABLE 
Factor                 Roots                Abs Recip    System Freq 
1+0.9653B             -1.0359               0.9653       0.5000
1+0.1323B             -7.5572               0.1323       0.5000
  
  

acf(hum$res)
ljung.wge(hum$res) #  Fail to reject  

Obs 0.01381014 0.005487669 -0.01488494 -0.09759935 -0.001680299 0.06445373 0.114192 -0.04943437 -0.03187326 -0.01261037 0.03869395 0.04164148 -0.03708437 -0.1178728 0.05037217 0.1033369 -0.02362139 0.00943292 -0.008141213 -0.0451568 -0.0939969 -0.02219895 0.02656584 -0.07296706 

$test
[1] "Ljung-Box test"

$K
[1] 24

$chi.square
[1] 30.75562

$df
[1] 24

$pval
[1] 0.1609546

ljung.wge(hum$res, K=48) # Fail to reject

Obs 0.01381014 0.005487669 -0.01488494 -0.09759935 -0.001680299 0.06445373 0.114192 -0.04943437 -0.03187326 -0.01261037 0.03869395 0.04164148 -0.03708437 -0.1178728 0.05037217 0.1033369 -0.02362139 0.00943292 -0.008141213 -0.0451568 -0.0939969 -0.02219895 0.02656584 -0.07296706 -0.06567389 -0.005756453 0.08350328 0.05608327 -0.01037953 -0.02658103 -0.01989446 -0.02674116 -0.01400777 0.1082012 0.006403354 -0.02056617 -0.07223008 0.08666904 0.0907162 -0.04411947 0.06947638 0.03408037 -0.04054732 0.03166965 0.01998761 0.01298515 -0.006023879 -0.09700959 

$test
[1] "Ljung-Box test"

$K
[1] 48

$chi.square
[1] 59.53045

$df
[1] 48

$pval
[1] 0.1228675

preds_Humidity = fore.arima.wge(daily_bike_data$Humidity, s = 365, phi = hum$phi, theta = hum$theta, n.ahead = 365)

y.arma -11.33333 -31.47826 0.3977273 -17.58514 8.721014 2.382246 3.297101 -7.083333 26.75 16.36051 16.11364 20.33712 3.708333 -8.032609 -7.958333 3.875 17.8587 -41.83333 -24.42391 -8.833333 37.41667 39.625 47.47283 34.40942 2.679348 -9.291667 5.375 -24.97101 -34.04891 -32.13406 -18.70833 -32.16486 -10.25 8.884058 19.43659 -24.125 5.384058 -24.20833 18.5 6.730072 10.26087 22.48864 -7.958333 -4.61413 13.29167 21.69022 32.94384 12.95833 1.791667 32.79167 10 -1.065217 -0.9861111 13.15399 4.01087 -31.63406 -12.79167 -18.91667 -48.05303 26.97826 16.58333 33.875 1.083333 -38.58333 -44.20109 -9.463768 9.25 -20.79167 40.70833 -29.91486 -11.76268 -3.822464 12.05435 -14.85688 -19.69384 23.91667 23.06159 43.08333 25.5 7.052536 19.66667 -0.8315217 -11.16667 39.04167 48.66667 -1.599638 -1.217391 16.70833 -20.75 -33.75 5.208333 2.25 2.434783 -2.958333 -17.25 -9.666667 -22.58333 -58.20833 -60.16667 -54 -28.19565 -26.96014 -35.29167 -13.20833 -16.83333 -38.04167 8.208333 -15.20833 -9.666667 -0.1666667 28.75 -4.666667 -5.25 -4.416667 -32.25 -30.125 -7.875 -30 3.25 8.375 -19.20833 -7.041667 10 3.125 29.125 16.66667 19.875 3.25 9.708333 25.5 -8.083333 -38.70833 -38.29167 -34.625 -7.75 0.6666667 -14 -35 -30.625 -26.33333 -9.625 6.166667 -4.416667 3.375 2.041667 6.958333 7.875 -3.25 -14.25 -0.04166667 3.333333 -18.41667 45.04167 19.5 3.708333 -16.54167 1.333333 1.333333 -5.5 -10.04167 -16.79167 -11.625 -16 33.875 7.5 9.791667 -9.875 -23.16667 -7.166667 11.125 -5.625 -17.83333 -13.95833 -12.95833 -3.875 -0.4166667 -0.9166667 -28.5 -27.41667 -7.541667 5.458333 20.5 7.416667 -23.54167 -14.58333 -5.166667 -28.54167 -20.04167 -26.58333 -3.541667 10.5 3.166667 7.416667 -10.20833 0.9583333 10.79167 13.29167 4.083333 -14.54167 -7.333333 -10.66667 15.29167 28.5 26.25 14.33333 -10.20833 -9.083333 19.375 1.125 7.083333 15.79167 18.79167 15.33333 18.625 0.2083333 -11.5 -1.75 -10.25 -9.875 11.16667 10.25 19.625 29.20833 31.79167 -19.91667 -27.20833 -2.541667 4.125 -5.625 -8.375 -11.95833 3.75 -3.583333 20.375 22.16667 3.083333 -15.66667 -4.833333 -0.4166667 16.8652 6.541667 0.375 -0.75 -5.166667 -8.875 9.833333 4.875 -3.541667 -14.57065 -10.66667 -20.33152 -9.875 -20.625 -21 -17.21739 -13.54167 -6 -3.666667 -8.875 -14.83333 3.958333 18.25 -34.45833 -28.16667 -23.33333 -32.58333 -39.54167 -35.20833 -27.83333 -25.45833 -15.79167 -0.9166667 -10.45833 -17.04167 -14.25 11.08333 8.375 7.5 0.6666667 -2 0.7083333 -1.791667 2.791667 -17.79167 -44.29167 -35.75 -22.16667 15.70833 22.08333 -2.125 -0.875 -16.68841 17.875 -0.125 -11.91667 -17.29167 -13.04167 1.333333 8 -0.5833333 13.41667 -18.79167 25.625 12.21212 -1.708333 -13.70833 -18 -13.125 1.375 -24.04167 -19.16667 -17.41667 -42.48551 -27.25 19.91667 10.625 28.33333 7.583333 -13.66667 -30.95833 -5.125 13.54167 19.08333 -6.125 -22.5 -34.875 -17.75 1.958333 -23.91667 -21.33333 -16.29167 4.362319 -32.45833 -5.768116 12.5 18.08333 21.04167 -0.8333333 -9.333333 -46.45833 -46.16667 18.41667 21.54167 39.79167 43.5 -7.416667 -5.166667 -17.79167 0.875 15 27.79167 32.08333 2.875 3 -19.04167 -20.08333 -24.5 -2.708333 11 22.78261 6.083333 14.90036 1.583333 11.625 -13.25 -11.5 

preds_Humidity_lag = dplyr::lag(preds_Humidity,4)

parzen.wge(daily_bike_data$Temperature, trunc = 300)

$freq
  [1] 0.001367989 0.002735978 0.004103967 0.005471956 0.006839945 0.008207934
  [7] 0.009575923 0.010943912 0.012311902 0.013679891 0.015047880 0.016415869
 [13] 0.017783858 0.019151847 0.020519836 0.021887825 0.023255814 0.024623803
 [19] 0.025991792 0.027359781 0.028727770 0.030095759 0.031463748 0.032831737
 [25] 0.034199726 0.035567715 0.036935705 0.038303694 0.039671683 0.041039672
 [31] 0.042407661 0.043775650 0.045143639 0.046511628 0.047879617 0.049247606
 [37] 0.050615595 0.051983584 0.053351573 0.054719562 0.056087551 0.057455540
 [43] 0.058823529 0.060191518 0.061559508 0.062927497 0.064295486 0.065663475
 [49] 0.067031464 0.068399453 0.069767442 0.071135431 0.072503420 0.073871409
 [55] 0.075239398 0.076607387 0.077975376 0.079343365 0.080711354 0.082079343
 [61] 0.083447332 0.084815321 0.086183311 0.087551300 0.088919289 0.090287278
 [67] 0.091655267 0.093023256 0.094391245 0.095759234 0.097127223 0.098495212
 [73] 0.099863201 0.101231190 0.102599179 0.103967168 0.105335157 0.106703146
 [79] 0.108071135 0.109439124 0.110807114 0.112175103 0.113543092 0.114911081
 [85] 0.116279070 0.117647059 0.119015048 0.120383037 0.121751026 0.123119015
 [91] 0.124487004 0.125854993 0.127222982 0.128590971 0.129958960 0.131326949
 [97] 0.132694938 0.134062927 0.135430917 0.136798906 0.138166895 0.139534884
[103] 0.140902873 0.142270862 0.143638851 0.145006840 0.146374829 0.147742818
[109] 0.149110807 0.150478796 0.151846785 0.153214774 0.154582763 0.155950752
[115] 0.157318741 0.158686731 0.160054720 0.161422709 0.162790698 0.164158687
[121] 0.165526676 0.166894665 0.168262654 0.169630643 0.170998632 0.172366621
[127] 0.173734610 0.175102599 0.176470588 0.177838577 0.179206566 0.180574555
[133] 0.181942544 0.183310534 0.184678523 0.186046512 0.187414501 0.188782490
[139] 0.190150479 0.191518468 0.192886457 0.194254446 0.195622435 0.196990424
[145] 0.198358413 0.199726402 0.201094391 0.202462380 0.203830369 0.205198358
[151] 0.206566347 0.207934337 0.209302326 0.210670315 0.212038304 0.213406293
[157] 0.214774282 0.216142271 0.217510260 0.218878249 0.220246238 0.221614227
[163] 0.222982216 0.224350205 0.225718194 0.227086183 0.228454172 0.229822161
[169] 0.231190150 0.232558140 0.233926129 0.235294118 0.236662107 0.238030096
[175] 0.239398085 0.240766074 0.242134063 0.243502052 0.244870041 0.246238030
[181] 0.247606019 0.248974008 0.250341997 0.251709986 0.253077975 0.254445964
[187] 0.255813953 0.257181943 0.258549932 0.259917921 0.261285910 0.262653899
[193] 0.264021888 0.265389877 0.266757866 0.268125855 0.269493844 0.270861833
[199] 0.272229822 0.273597811 0.274965800 0.276333789 0.277701778 0.279069767
[205] 0.280437756 0.281805746 0.283173735 0.284541724 0.285909713 0.287277702
[211] 0.288645691 0.290013680 0.291381669 0.292749658 0.294117647 0.295485636
[217] 0.296853625 0.298221614 0.299589603 0.300957592 0.302325581 0.303693570
[223] 0.305061560 0.306429549 0.307797538 0.309165527 0.310533516 0.311901505
[229] 0.313269494 0.314637483 0.316005472 0.317373461 0.318741450 0.320109439
[235] 0.321477428 0.322845417 0.324213406 0.325581395 0.326949384 0.328317373
[241] 0.329685363 0.331053352 0.332421341 0.333789330 0.335157319 0.336525308
[247] 0.337893297 0.339261286 0.340629275 0.341997264 0.343365253 0.344733242
[253] 0.346101231 0.347469220 0.348837209 0.350205198 0.351573187 0.352941176
[259] 0.354309166 0.355677155 0.357045144 0.358413133 0.359781122 0.361149111
[265] 0.362517100 0.363885089 0.365253078 0.366621067 0.367989056 0.369357045
[271] 0.370725034 0.372093023 0.373461012 0.374829001 0.376196990 0.377564979
[277] 0.378932969 0.380300958 0.381668947 0.383036936 0.384404925 0.385772914
[283] 0.387140903 0.388508892 0.389876881 0.391244870 0.392612859 0.393980848
[289] 0.395348837 0.396716826 0.398084815 0.399452804 0.400820793 0.402188782
[295] 0.403556772 0.404924761 0.406292750 0.407660739 0.409028728 0.410396717
[301] 0.411764706 0.413132695 0.414500684 0.415868673 0.417236662 0.418604651
[307] 0.419972640 0.421340629 0.422708618 0.424076607 0.425444596 0.426812585
[313] 0.428180575 0.429548564 0.430916553 0.432284542 0.433652531 0.435020520
[319] 0.436388509 0.437756498 0.439124487 0.440492476 0.441860465 0.443228454
[325] 0.444596443 0.445964432 0.447332421 0.448700410 0.450068399 0.451436389
[331] 0.452804378 0.454172367 0.455540356 0.456908345 0.458276334 0.459644323
[337] 0.461012312 0.462380301 0.463748290 0.465116279 0.466484268 0.467852257
[343] 0.469220246 0.470588235 0.471956224 0.473324213 0.474692202 0.476060192
[349] 0.477428181 0.478796170 0.480164159 0.481532148 0.482900137 0.484268126
[355] 0.485636115 0.487004104 0.488372093 0.489740082 0.491108071 0.492476060
[361] 0.493844049 0.495212038 0.496580027 0.497948016 0.499316005

$pzgram
  [1]  18.34127014  19.33295660  18.49116970  15.54968535  10.75586223
  [6]   6.09680513   4.02057139   3.14092089   2.57247201   1.64560045
 [11]   0.77299661   0.65926447   0.75949820   0.19533007  -1.13153453
 [16]  -1.96766704  -1.41785413  -0.61531045  -0.41015206  -1.03934961
 [21]  -2.36234340  -3.62515719  -4.16332323  -4.38768691  -3.79951381
 [26]  -1.97323906  -0.46563877   0.01922867  -0.22841375  -0.91941743
 [31]  -2.04751273  -3.04466030  -3.11740402  -3.14491297  -3.97557100
 [36]  -4.93098878  -4.76774497  -4.18747614  -4.48326505  -5.71244648
 [41]  -6.24247169  -5.32950795  -4.70985239  -4.57353016  -3.96340743
 [46]  -3.27238705  -3.51753670  -4.69288770  -5.81994149  -6.31909354
 [51]  -6.21784016  -5.21201990  -4.28908111  -4.40149120  -4.98065530
 [56]  -4.81695326  -4.54854156  -5.22079546  -6.57252953  -7.35366568
 [61]  -6.93109722  -6.16060566  -5.95670044  -6.53700722  -7.29818563
 [66]  -7.40918290  -7.15004734  -7.15224648  -7.31855368  -7.17783796
 [71]  -6.73686181  -6.50385011  -6.64579756  -6.57334686  -5.99998594
 [76]  -5.84711666  -6.84637984  -8.16246542  -7.23824341  -5.44466201
 [81]  -5.02601647  -6.21984146  -7.62243788  -6.82113914  -5.40071306
 [86]  -4.97200337  -5.31550916  -5.86794443  -6.70449939  -7.94656902
 [91]  -8.34627845  -7.30946727  -6.33771299  -6.06612761  -6.32254766
 [96]  -6.51771148  -6.08080782  -5.28932795  -4.54320216  -4.00543709
[101]  -3.76310980  -3.41190389  -2.76856819  -2.71594089  -3.99867393
[106]  -6.08967529  -6.45194228  -5.20552402  -4.49328166  -4.57384283
[111]  -5.12503847  -5.94547698  -6.80800797  -7.27205406  -7.44993272
[116]  -7.92151769  -8.42038854  -8.18054811  -7.61920501  -7.34781133
[121]  -7.33855819  -7.67761850  -8.47581961  -8.93804340  -8.38058152
[126]  -7.89106100  -8.22431462  -8.94781004  -8.74879595  -7.00625409
[131]  -5.11875112  -4.30229412  -4.94110126  -7.04349339 -10.18880662
[136] -12.74313944 -12.15909090  -9.07438355  -6.25633537  -4.92084527
[141]  -5.29241627  -7.24037521 -10.07454611 -12.28642496 -12.98668920
[146] -12.46472026 -11.58216009 -11.02785250 -10.86405278 -10.99915026
[151] -11.24037987 -11.36250352 -11.50870836 -11.58390007 -10.78204793
[156]  -9.44471373  -8.85470303  -9.46410799 -10.47064053 -10.21654245
[161]  -9.38254129  -9.39371033  -9.76753540  -9.10398560  -8.19850036
[166]  -8.50995220 -10.33107558 -12.46597818 -12.34223547 -11.09211899
[171] -10.70718725 -11.21725097 -11.15848739  -9.90890296  -8.94430275
[176]  -8.67994122  -8.64443823  -8.74529067  -9.15031562  -9.60863489
[181]  -9.90268951 -10.33500649 -11.22768413 -12.50537351 -13.50282612
[186] -13.57107161 -13.27909418 -13.52063270 -14.49219372 -15.22462315
[191] -14.71037295 -14.17206104 -14.59710262 -15.71638851 -16.76922312
[196] -17.00232811 -15.83270397 -14.20137844 -13.18649623 -12.47869592
[201] -11.40556671 -10.52315088 -10.58322539 -11.26755098 -11.52006185
[206] -11.53384578 -12.31958256 -13.86346458 -15.23501740 -15.97427908
[211] -16.05155167 -15.11941977 -13.75758856 -12.79073460 -12.53549068
[216] -13.07465015 -14.26069628 -15.24841824 -14.97873143 -13.96573122
[221] -12.88416203 -11.80905853 -11.00403851 -10.81378985 -11.39033772
[226] -12.70296637 -14.39261507 -15.61658265 -15.90295025 -15.71405935
[231] -15.54685394 -15.59837943 -15.73590033 -15.59279995 -14.91706817
[236] -14.00057156 -13.42016328 -13.45443658 -14.04269269 -14.98643738
[241] -16.08859676 -16.96899011 -16.85302095 -16.01872104 -15.66260355
[246] -16.02888768 -16.62089143 -17.41712341 -18.83838576 -20.23724704
[251] -20.12590813 -19.40191885 -19.36596724 -19.41924815 -18.17146502
[256] -16.38483976 -15.02173480 -14.05052722 -13.52598339 -13.61134637
[261] -13.99004653 -14.12851539 -14.21670967 -14.61899122 -15.04765678
[266] -15.27106275 -15.54794120 -15.64978445 -15.18504984 -14.46514345
[271] -13.71880522 -13.23589166 -13.65770964 -15.38025268 -18.01436136
[276] -20.00640418 -20.60030105 -20.74584588 -20.79362578 -20.65769737
[281] -20.36184387 -19.75648074 -18.38140046 -16.63420181 -15.41360209
[286] -15.17958020 -16.09525394 -18.14620856 -20.58325199 -20.95975256
[291] -19.26397827 -17.93105324 -17.34992847 -16.58630130 -15.30132418
[296] -14.31988274 -13.92566141 -13.81170309 -13.93688606 -14.58635135
[301] -15.86578973 -17.37999669 -17.69182374 -16.39118710 -15.28887889
[306] -14.90462972 -14.42112223 -13.39650082 -12.53003127 -12.43967309
[311] -13.28613470 -14.90270409 -16.67555961 -17.57969390 -17.14185990
[316] -16.15194517 -15.70700669 -16.32584409 -17.64862297 -18.16190780
[321] -17.35156029 -16.64214661 -16.63859255 -16.91132785 -16.77201943
[326] -16.39993512 -16.48080804 -17.18885223 -18.12497402 -18.86913131
[331] -19.44067062 -19.82217701 -19.81191749 -19.32256117 -18.42644176
[336] -17.64777784 -17.54160898 -18.11343863 -18.92169388 -19.78229851
[341] -21.00798730 -22.06800048 -21.05281603 -18.94525535 -17.67135474
[346] -17.65035831 -18.74869640 -20.35640956 -21.27766197 -21.22908987
[351] -20.83891062 -20.11122540 -19.18831991 -18.41050275 -17.78834832
[356] -17.27847217 -16.82214296 -16.23200552 -15.67545468 -15.67317837
[361] -16.47595256 -17.83681868 -19.31609828 -20.88765969 -22.38148475

tempdiff = artrans.wge(daily_bike_data$Temperature, phi.tr = c(rep(0,364),1))

plotts.sample.wge(tempdiff)

$xbar
[1] 1.530127

$autplt
 [1]  1.000000000  0.672651112  0.303843904  0.137342310  0.135661326
 [6]  0.162071006  0.144637010  0.153902985  0.128590825  0.087915982
[11]  0.011149678 -0.044560140  0.003913322  0.063322556  0.098446867
[16]  0.062263260  0.054955303  0.047922129 -0.014798551 -0.030715819
[21]  0.001713817  0.046921231  0.064689447  0.019192525  0.003250627
[26]  0.005805687

$freq
  [1] 0.002732240 0.005464481 0.008196721 0.010928962 0.013661202 0.016393443
  [7] 0.019125683 0.021857923 0.024590164 0.027322404 0.030054645 0.032786885
 [13] 0.035519126 0.038251366 0.040983607 0.043715847 0.046448087 0.049180328
 [19] 0.051912568 0.054644809 0.057377049 0.060109290 0.062841530 0.065573770
 [25] 0.068306011 0.071038251 0.073770492 0.076502732 0.079234973 0.081967213
 [31] 0.084699454 0.087431694 0.090163934 0.092896175 0.095628415 0.098360656
 [37] 0.101092896 0.103825137 0.106557377 0.109289617 0.112021858 0.114754098
 [43] 0.117486339 0.120218579 0.122950820 0.125683060 0.128415301 0.131147541
 [49] 0.133879781 0.136612022 0.139344262 0.142076503 0.144808743 0.147540984
 [55] 0.150273224 0.153005464 0.155737705 0.158469945 0.161202186 0.163934426
 [61] 0.166666667 0.169398907 0.172131148 0.174863388 0.177595628 0.180327869
 [67] 0.183060109 0.185792350 0.188524590 0.191256831 0.193989071 0.196721311
 [73] 0.199453552 0.202185792 0.204918033 0.207650273 0.210382514 0.213114754
 [79] 0.215846995 0.218579235 0.221311475 0.224043716 0.226775956 0.229508197
 [85] 0.232240437 0.234972678 0.237704918 0.240437158 0.243169399 0.245901639
 [91] 0.248633880 0.251366120 0.254098361 0.256830601 0.259562842 0.262295082
 [97] 0.265027322 0.267759563 0.270491803 0.273224044 0.275956284 0.278688525
[103] 0.281420765 0.284153005 0.286885246 0.289617486 0.292349727 0.295081967
[109] 0.297814208 0.300546448 0.303278689 0.306010929 0.308743169 0.311475410
[115] 0.314207650 0.316939891 0.319672131 0.322404372 0.325136612 0.327868852
[121] 0.330601093 0.333333333 0.336065574 0.338797814 0.341530055 0.344262295
[127] 0.346994536 0.349726776 0.352459016 0.355191257 0.357923497 0.360655738
[133] 0.363387978 0.366120219 0.368852459 0.371584699 0.374316940 0.377049180
[139] 0.379781421 0.382513661 0.385245902 0.387978142 0.390710383 0.393442623
[145] 0.396174863 0.398907104 0.401639344 0.404371585 0.407103825 0.409836066
[151] 0.412568306 0.415300546 0.418032787 0.420765027 0.423497268 0.426229508
[157] 0.428961749 0.431693989 0.434426230 0.437158470 0.439890710 0.442622951
[163] 0.445355191 0.448087432 0.450819672 0.453551913 0.456284153 0.459016393
[169] 0.461748634 0.464480874 0.467213115 0.469945355 0.472677596 0.475409836
[175] 0.478142077 0.480874317 0.483606557 0.486338798 0.489071038 0.491803279
[181] 0.494535519 0.497267760 0.500000000

$dbz
  [1]   6.86101403   6.80876323   6.72324697   6.60681842   6.46275280
  [6]   6.29518360   6.10896488   5.90943557   5.70207779   5.49209097
 [11]   5.28393959   5.08096222   4.88513693   4.69707086   4.51622501
 [16]   4.34131772   4.17080026   4.00328139   3.83779884   3.67388279
 [21]   3.51141617   3.35035329   3.19040163   3.03078743   2.87020901
 [26]   2.70703353   2.53972834   2.36745799   2.19073589   2.01199999
 [31]   1.83597637   1.66969949   1.52208037   1.40297641   1.32183779
 [36]   1.28616944   1.30018185   1.36400724   1.47368247   1.62182413
 [41]   1.79870088   1.99335525   2.19452831   2.39129863   2.57346871
 [46]   2.73178552   2.85808032   2.94538703   2.98807204   2.98199008
 [51]   2.92467221   2.81554605   2.65618008   2.45052682   2.20511017
 [56]   1.92906089   1.63386261   1.33265826   1.03902624   0.76530524
 [61]   0.52079716   0.31038312   0.13406916  -0.01233017  -0.13560508
 [66]  -0.24320235  -0.34147694  -0.43450667  -0.52359030  -0.60738021
 [71]  -0.68252028  -0.74462569  -0.78941644  -0.81379494  -0.81666574
 [76]  -0.79935507  -0.76559578  -0.72115865  -0.67328426  -0.63007626
 [81]  -0.59996988  -0.59132308  -0.61212267  -0.66976563  -0.77086635
 [86]  -0.92104105  -1.12462508  -1.38428033  -1.70045122  -2.07063612
 [91]  -2.48847413  -2.94273603  -3.41648838  -3.88697956  -4.32706285
 [96]  -4.70888160  -5.00963751  -5.21760888  -5.33545222  -5.37882273
[101]  -5.37112173  -5.33721388  -5.29867154  -5.27146464  -5.26568972
[106]  -5.28650316  -5.33555591  -5.41248757  -5.51622460  -5.64592813
[111]  -5.80149774  -5.98359790  -6.19324142  -6.43102448  -6.69614549
[116]  -6.98535979  -7.29204724  -7.60562670  -7.91163947  -8.19287331
[121]  -8.43176420  -8.61384892  -8.73133573  -8.78539396  -8.78610788
[126]  -8.75015225  -8.69730281  -8.64713015  -8.61669081  -8.61932215
[131]  -8.66421416  -8.75632540  -8.89629021  -9.08009989  -9.29849275
[136]  -9.53618459  -9.77136785  -9.97629436 -10.12000705 -10.17384969
[141] -10.11878205  -9.95144149  -9.68550349  -9.34748397  -8.96955464
[146]  -8.58297237  -8.21412579  -7.88318277  -7.60436548  -7.38689424
[151]  -7.23600789  -7.15379983  -7.13980723  -7.19138491  -7.30393449
[156]  -7.47107535  -7.68485057  -7.93605820  -8.21477424  -8.51107680
[161]  -8.81588863  -9.12175202  -9.42328792  -9.71712517 -10.00122947
[166] -10.27376628 -10.53181430 -10.77034554 -10.98188641 -11.15716066
[171] -11.28676196 -11.36350549 -11.38469739 -11.35342402 -11.27831471
[176] -11.17192568 -11.04846399 -10.92167297 -10.80339363 -10.70290660
[181] -10.62688205 -10.57966869 -10.56367547

aic5.wge(tempdiff, type = 'bic') # bic picked p = 1 and q = 1

---------WORKING... PLEASE WAIT... 


Five Smallest Values of  bic 
    p    q        bic
    1    1   3.714381
    2    0   3.720397
    3    0   3.722154
    0    2   3.723965
    1    2   3.726426

temp = est.arma.wge(tempdiff, p = 1, q = 1)

  
  
Coefficients of AR polynomial:  
0.4839 

                           AR Factor Table 
Factor                 Roots                Abs Recip    System Freq 
1-0.4839B              2.0667               0.4839       0.0000
  
  
  
  
Coefficients of MA polynomial:  
-0.3906 

                              MA FACTOR TABLE 
Factor                 Roots                Abs Recip    System Freq 
1+0.3906B             -2.5605               0.3906       0.5000
  
  

acf(temp$res)

ljung.wge(temp$res) # close to 0.05 but Fail to reject  

Obs 0.01228195 -0.0002127207 -0.07945629 0.0267131 0.1107299 -0.02603524 0.1025488 0.01861338 0.05959623 0.01229143 -0.1240381 0.03700199 0.004279513 0.115961 -0.03897411 0.0003535096 0.08749307 -0.05580738 -0.03367594 -0.0009418035 0.01374499 0.088237 -0.05257655 0.005048402 

$test
[1] "Ljung-Box test"

$K
[1] 24

$chi.square
[1] 33.87608

$df
[1] 24

$pval
[1] 0.08689569

ljung.wge(temp$res, K=48) # Fail to reject

Obs 0.01228195 -0.0002127207 -0.07945629 0.0267131 0.1107299 -0.02603524 0.1025488 0.01861338 0.05959623 0.01229143 -0.1240381 0.03700199 0.004279513 0.115961 -0.03897411 0.0003535096 0.08749307 -0.05580738 -0.03367594 -0.0009418035 0.01374499 0.088237 -0.05257655 0.005048402 -0.008982536 0.01088205 -0.008136983 0.004781849 0.08392675 -0.0567659 -0.02341514 -0.05085354 0.03217923 -0.04656861 -0.0141383 0.02833786 0.05223805 -0.002588415 -0.02656257 -0.04648866 0.04865447 0.002639143 0.04907394 0.04937573 0.1014075 0.006801172 0.01647366 -0.07264651 

$test
[1] "Ljung-Box test"

$K
[1] 48

$chi.square
[1] 53.06362

$df
[1] 48

$pval
[1] 0.2852875

preds_Temperature = fore.arima.wge(daily_bike_data$Temperature, s = 365, phi = temp$phi, theta = temp$theta, n.ahead = 365)

y.arma 2.229167 -7.821739 -3.998106 -7.997645 3.351449 11.22011 17.02029 14.90417 7.408333 13.62971 9.052273 18.11364 9.408333 1.66413 -5.758333 -3.595833 17.04112 7.466667 -8.842029 -3.8125 -0.3666667 8.934239 10.49529 21.15018 6.088406 10.68542 19.84583 9.702717 7.414674 4.530072 18.05 23.91775 11.99583 10.91649 4.561594 2.804167 -0.2550725 7.133333 3.091667 11.23261 11.77355 3.0375 -8.191667 -8.112138 -8.279167 7.09837 -0.1268116 -7.991667 -15.09583 -10.29167 -0.4521739 -1.332609 18.44444 20.08279 9.667029 -6.338587 -0.2916667 2.007246 -4.160985 6.703986 13.0125 13.4 13.175 -5.0375 -11.49891 -0.2813406 9.629167 20.00833 1.868939 -2.495833 2.812681 7.093116 20.70199 22.01304 16.58279 1.804167 -2.232971 0 18.35 11.26957 7.770833 17.87808 27.325 20.5875 14.825 16.64928 5.100181 15.69167 16.7625 8.783333 10.725 9.575 4.801449 -9.2125 11 3.804167 -2.954167 8.770833 13.575 5.3875 -12.85815 -13.27609 -1.304167 -2.1625 4.166667 15.15833 17.90833 8.279167 -3.683333 -8.354167 5.825 20.1375 -5.441667 -22.425 -16.69167 -13.375 -10.48333 -13.79583 -11.50833 -1.225 1.091667 5.5375 -4.5375 12.6 14.5375 12.27917 3.6875 0.7916667 4.241667 3.654167 -3.1625 -0.1458333 4.441667 7.916667 0.925 2.941667 6.45 3.725 2.8875 5.458333 1.570833 -0.5083333 -1.445833 -3.308333 -0.5 -2.441667 0.9375 2.958333 3.8875 -0.9208333 -10.22083 -7.283333 -5.245833 -3.170833 -2.808333 -4.395833 -11.85833 -13.22917 -14.9625 -13.74167 -3.808333 0.1458333 2.4375 1.583333 4.458333 1.870833 0.9333333 -1.525 -9.004167 -11.28333 4.616667 8.7625 6.2625 4.258333 0.6583333 4.170833 3.075 -4.466667 -4.020833 1.791667 11.875 3.654167 6.7 5.625 4.6875 3.679167 9.279167 6.775 13.175 7.7 -3.170833 -3.595833 -6.7125 -2.679167 4.383333 3.441667 5.095833 3.820833 6.183333 1.45 0.1333333 -12.90417 -21.79167 -15.68333 -7.633333 0.6458333 -4.1125 0.125 0.2208333 -7.125 -7.145833 -6.495833 -5.045833 -5.6875 1.775 4.816667 7.125 4.541667 0.8708333 -2.520833 -2.15 -0.9583333 -0.1333333 -1.3875 1.291667 3.808333 5.25 0.5041667 -0.35 1.025 -0.5666667 -5.3375 -6.4625 -3.670833 2.3125 1.941667 1.583333 -3.329167 -2.298611 -0.322549 7.9125 3.954167 4.308333 9.433333 9.5 2.379167 -0.1291667 4.541667 16.96667 8.408333 5.987862 0.7708333 -4.320833 -6.045833 -5.770471 -4.466667 -5.25 4.8125 12.01667 7.595833 6.320833 6.416667 -0.7791667 -4.170833 -2.520833 3.508333 -6.6625 -10.35417 -8.558333 -0.1375 1.283333 0.2041667 -1.879167 10.0625 14.16667 17.82917 14.9625 10.26667 10.43333 3.754167 -9.125 -13.6125 -10.7125 -4.541667 -9.35 -13.07917 -13.5875 1.283333 4.320833 -5.666667 -6.620833 -1.656159 7.55 4.8875 3.591667 5.683333 6.983333 9.983333 5.691667 6.5625 17.17083 19.25417 10.46667 -1.869697 -3.7375 -1.004167 -4.6 -5.170833 -0.06666667 -2.508333 -9.845833 -9.733333 -4.12971 -1.608333 5.616667 5.545833 3.808333 -16.11667 -20.775 -11.65833 0.3041667 4.391667 1.1625 -7.1 -6.3375 -5.483333 -8.7 -0.4375 -8.345833 -11.21667 -12.59583 -18.28496 -13.9625 -3.807246 -1.216667 -1.370833 4.1625 10.50833 7.75 -2.091667 -13.31667 4.766667 7.85 9.454167 18.56667 9.9375 1.2875 -1.875 -12.17083 -4.379167 9.029167 13.39167 11.58333 -4.6375 -8.495833 -8.3625 -9.295833 -4.891667 -3.756522 -2.617391 -7.0625 -3.8875 0.45 -5.045833 -13.325 -13.32083 

sequence_length <- 366
pred_Days_of_the_Week <- (2:sequence_length) %% 7

plotts.sample.wge(daily_bike_data$Wind_Speed, trunc = 300)

$xbar
[1] 12.76227

$autplt
 [1]  1.000000000  0.326423464  0.056437335  0.055355010  0.041954482
 [6]  0.078641959  0.063566217  0.012863218 -0.011895845  0.033532168
[11]  0.094405045  0.102575797  0.034418821  0.070151667  0.072308807
[16]  0.115595551  0.172187129  0.063167847  0.032315535 -0.002191299
[21] -0.030467438  0.030991528  0.019502839 -0.013835894  0.034480516
[26]  0.041820645

$freq
  [1] 0.001367989 0.002735978 0.004103967 0.005471956 0.006839945 0.008207934
  [7] 0.009575923 0.010943912 0.012311902 0.013679891 0.015047880 0.016415869
 [13] 0.017783858 0.019151847 0.020519836 0.021887825 0.023255814 0.024623803
 [19] 0.025991792 0.027359781 0.028727770 0.030095759 0.031463748 0.032831737
 [25] 0.034199726 0.035567715 0.036935705 0.038303694 0.039671683 0.041039672
 [31] 0.042407661 0.043775650 0.045143639 0.046511628 0.047879617 0.049247606
 [37] 0.050615595 0.051983584 0.053351573 0.054719562 0.056087551 0.057455540
 [43] 0.058823529 0.060191518 0.061559508 0.062927497 0.064295486 0.065663475
 [49] 0.067031464 0.068399453 0.069767442 0.071135431 0.072503420 0.073871409
 [55] 0.075239398 0.076607387 0.077975376 0.079343365 0.080711354 0.082079343
 [61] 0.083447332 0.084815321 0.086183311 0.087551300 0.088919289 0.090287278
 [67] 0.091655267 0.093023256 0.094391245 0.095759234 0.097127223 0.098495212
 [73] 0.099863201 0.101231190 0.102599179 0.103967168 0.105335157 0.106703146
 [79] 0.108071135 0.109439124 0.110807114 0.112175103 0.113543092 0.114911081
 [85] 0.116279070 0.117647059 0.119015048 0.120383037 0.121751026 0.123119015
 [91] 0.124487004 0.125854993 0.127222982 0.128590971 0.129958960 0.131326949
 [97] 0.132694938 0.134062927 0.135430917 0.136798906 0.138166895 0.139534884
[103] 0.140902873 0.142270862 0.143638851 0.145006840 0.146374829 0.147742818
[109] 0.149110807 0.150478796 0.151846785 0.153214774 0.154582763 0.155950752
[115] 0.157318741 0.158686731 0.160054720 0.161422709 0.162790698 0.164158687
[121] 0.165526676 0.166894665 0.168262654 0.169630643 0.170998632 0.172366621
[127] 0.173734610 0.175102599 0.176470588 0.177838577 0.179206566 0.180574555
[133] 0.181942544 0.183310534 0.184678523 0.186046512 0.187414501 0.188782490
[139] 0.190150479 0.191518468 0.192886457 0.194254446 0.195622435 0.196990424
[145] 0.198358413 0.199726402 0.201094391 0.202462380 0.203830369 0.205198358
[151] 0.206566347 0.207934337 0.209302326 0.210670315 0.212038304 0.213406293
[157] 0.214774282 0.216142271 0.217510260 0.218878249 0.220246238 0.221614227
[163] 0.222982216 0.224350205 0.225718194 0.227086183 0.228454172 0.229822161
[169] 0.231190150 0.232558140 0.233926129 0.235294118 0.236662107 0.238030096
[175] 0.239398085 0.240766074 0.242134063 0.243502052 0.244870041 0.246238030
[181] 0.247606019 0.248974008 0.250341997 0.251709986 0.253077975 0.254445964
[187] 0.255813953 0.257181943 0.258549932 0.259917921 0.261285910 0.262653899
[193] 0.264021888 0.265389877 0.266757866 0.268125855 0.269493844 0.270861833
[199] 0.272229822 0.273597811 0.274965800 0.276333789 0.277701778 0.279069767
[205] 0.280437756 0.281805746 0.283173735 0.284541724 0.285909713 0.287277702
[211] 0.288645691 0.290013680 0.291381669 0.292749658 0.294117647 0.295485636
[217] 0.296853625 0.298221614 0.299589603 0.300957592 0.302325581 0.303693570
[223] 0.305061560 0.306429549 0.307797538 0.309165527 0.310533516 0.311901505
[229] 0.313269494 0.314637483 0.316005472 0.317373461 0.318741450 0.320109439
[235] 0.321477428 0.322845417 0.324213406 0.325581395 0.326949384 0.328317373
[241] 0.329685363 0.331053352 0.332421341 0.333789330 0.335157319 0.336525308
[247] 0.337893297 0.339261286 0.340629275 0.341997264 0.343365253 0.344733242
[253] 0.346101231 0.347469220 0.348837209 0.350205198 0.351573187 0.352941176
[259] 0.354309166 0.355677155 0.357045144 0.358413133 0.359781122 0.361149111
[265] 0.362517100 0.363885089 0.365253078 0.366621067 0.367989056 0.369357045
[271] 0.370725034 0.372093023 0.373461012 0.374829001 0.376196990 0.377564979
[277] 0.378932969 0.380300958 0.381668947 0.383036936 0.384404925 0.385772914
[283] 0.387140903 0.388508892 0.389876881 0.391244870 0.392612859 0.393980848
[289] 0.395348837 0.396716826 0.398084815 0.399452804 0.400820793 0.402188782
[295] 0.403556772 0.404924761 0.406292750 0.407660739 0.409028728 0.410396717
[301] 0.411764706 0.413132695 0.414500684 0.415868673 0.417236662 0.418604651
[307] 0.419972640 0.421340629 0.422708618 0.424076607 0.425444596 0.426812585
[313] 0.428180575 0.429548564 0.430916553 0.432284542 0.433652531 0.435020520
[319] 0.436388509 0.437756498 0.439124487 0.440492476 0.441860465 0.443228454
[325] 0.444596443 0.445964432 0.447332421 0.448700410 0.450068399 0.451436389
[331] 0.452804378 0.454172367 0.455540356 0.456908345 0.458276334 0.459644323
[337] 0.461012312 0.462380301 0.463748290 0.465116279 0.466484268 0.467852257
[343] 0.469220246 0.470588235 0.471956224 0.473324213 0.474692202 0.476060192
[349] 0.477428181 0.478796170 0.480164159 0.481532148 0.482900137 0.484268126
[355] 0.485636115 0.487004104 0.488372093 0.489740082 0.491108071 0.492476060
[361] 0.493844049 0.495212038 0.496580027 0.497948016 0.499316005

$dbz
  [1]   8.177218907   8.749359188   7.905939871   5.681016856   3.064792060
  [6]   1.164661410  -0.142763771  -0.763396339  -0.481273119   0.317064061
 [11]   1.213786007   2.102627933   3.156880867   4.112308710   4.417826208
 [16]   3.873956802   2.721370972   1.612814367   1.362936809   1.802493360
 [21]   1.882963138   1.007338804  -0.677142701  -2.195041318  -2.446326027
 [26]  -1.777441319  -0.941487814  -0.178964193   0.350705804   0.580007671
 [31]   0.880302070   1.418940310   1.496226837   0.585276909  -0.489599601
 [36]  -0.033622803   0.990426800   1.297202499   1.103770499   0.886890880
 [41]   0.627062126   0.455099549   0.999754169   2.221921558   3.205587451
 [46]   3.506806305   3.614163672   4.082407319   4.439030630   4.204519941
 [51]   3.726989501   3.699723825   4.106866900   4.252430511   3.698240741
 [56]   2.820840910   2.638217662   3.125391761   3.309702653   2.683930292
 [61]   1.157133068  -0.898236060  -2.043566942  -1.630908107  -1.362822991
 [66]  -1.918238270  -2.137305102  -0.945885729   0.723002036   2.075879307
 [71]   2.664907738   2.038850287   0.005499153  -2.506382522  -2.561634541
 [76]  -0.674260202   0.832347695   1.328259716   0.816982582  -0.151508951
 [81]  -0.929239589  -1.604494148  -1.576415831   0.143075265   2.078264462
 [86]   3.146851891   3.409384556   3.211348955   2.783101306   2.104342192
 [91]   1.010089587  -0.263800693  -0.400220702   0.751719483   1.455837263
 [96]   1.055963854   0.269870399   0.606887841   1.823825122   2.566536079
[101]   2.409234159   1.608237637   0.601391186  -0.482343799  -1.365658626
[106]  -1.086777662   0.019694441   0.626827392   0.223545533  -0.955916969
[111]  -1.954280645  -2.095280525  -2.260376630  -3.114778465  -3.723867263
[116]  -2.712108931  -1.002775130   0.411958172   1.277335698   1.366348542
[121]   0.481964436  -1.309409906  -2.592442146  -0.892813992   1.456771248
[126]   2.491974152   2.304901559   1.736222868   1.584378852   1.971756505
[131]   2.625866533   2.960023501   2.707236269   2.342333213   2.248129265
[136]   2.262255562   2.514493561   2.927416854   2.972047389   2.619149852
[141]   2.289999038   1.964365674   1.350132986   1.139888218   2.287100991
[146]   3.534425882   3.596606465   2.307599663   0.405690384  -0.697793783
[151]  -0.713726560  -0.222555737   0.440245631   0.862018844   0.818965256
[156]   0.449221824   0.096793225  -0.100968167  -0.386951946  -0.942344972
[161]  -1.635047628  -2.136114375  -2.110003448  -1.594835659  -1.008585472
[166]  -0.747035524  -0.950533109  -1.229117240  -1.016495098  -0.613646926
[171]  -0.506214015  -0.572474643  -0.712955511  -1.165180541  -1.777377289
[176]  -1.805612328  -0.996320951   0.047395837   0.626836518   0.401674968
[181]  -0.295501685  -0.661760737  -0.713861076  -1.087246343  -1.643429804
[186]  -1.548915677  -0.883928592  -0.723533924  -1.639221446  -3.225654112
[191]  -4.107412815  -3.817234945  -3.031117591  -2.073936260  -1.597412452
[196]  -2.055047754  -2.541965011  -1.640140174  -0.515222140  -0.296789856
[201]  -0.703997618  -1.076168949  -1.172940393  -0.717652709   0.416428618
[206]   1.391977859   1.357897033   0.025119508  -1.823955428  -1.859005725
[211]  -0.830088046  -0.835265190  -1.838239414  -2.564308991  -2.398803526
[216]  -2.027441349  -1.787697865  -1.774450427  -1.864520841  -1.513503369
[221]  -0.767121654  -0.426354849  -0.730276205  -0.937734836  -0.594313193
[226]  -0.521629272  -1.190729274  -1.920104380  -1.574175311  -0.444747337
[231]   0.380062674   0.630592384   0.688906478   0.533950570  -0.345850215
[236]  -1.567439017  -1.714895255  -1.387416208  -1.887065108  -2.796779365
[241]  -2.443932822  -0.890161724   0.109746704  -0.297665294  -1.899066890
[246]  -2.812607666  -1.980080873  -1.406365941  -1.836025486  -2.691765909
[251]  -3.157233507  -3.548357996  -4.901515673  -7.719295128 -11.007119421
[256] -10.298468594  -6.590835470  -3.920808460  -2.972214471  -3.428137600
[261]  -4.312533553  -4.391226454  -3.623790158  -2.741957742  -2.026558645
[266]  -1.265947134  -0.465198494   0.050683435   0.220345545   0.212540605
[271]   0.294382421   0.756740396   1.202995973   0.843952570  -0.538434444
[276]  -2.109072880  -2.491856333  -2.222949687  -2.535181418  -3.248694884
[281]  -2.917086421  -1.533555649  -0.422332668  -0.139979873  -0.818740158
[286]  -2.181488413  -3.236556641  -3.326732282  -2.736373448  -1.950808606
[291]  -1.881501312  -3.185991085  -5.580478771  -6.870828723  -5.908706086
[296]  -4.968152342  -5.061797043  -6.080968876  -7.187844425  -7.199543533
[301]  -6.030620626  -4.709887134  -4.065380853  -4.266674262  -4.919268279
[306]  -5.329837325  -5.106873057  -4.426711585  -3.370047088  -1.901752164
[311]  -0.693279709  -0.594805767  -1.926432377  -4.025965856  -4.887550845
[316]  -4.605855728  -4.739337199  -4.636484646  -3.060738723  -1.290692719
[321]  -0.676748554  -1.535933325  -3.581108675  -5.288342933  -4.900284716
[326]  -3.920178311  -3.582816936  -3.600941089  -3.390011523  -3.036689889
[331]  -2.734068255  -2.299763831  -1.904669235  -2.033559177  -2.767826598
[336]  -3.670065546  -4.358391479  -5.004743902  -5.619481217  -5.384501876
[341]  -4.066957111  -2.817161605  -2.409390771  -2.855869701  -3.655714115
[346]  -4.234687536  -4.590581199  -5.062124029  -5.877411226  -6.948512770
[351]  -7.698746719  -7.987072780  -7.969760413  -6.656336188  -4.607166429
[356]  -3.360395072  -3.160854551  -3.599473823  -4.396389950  -5.445097395
[361]  -5.812084798  -4.813891817  -3.834628183  -3.740777778  -4.154685737

winddiff = artrans.wge(daily_bike_data$Wind_Speed, phi.tr = c(rep(0,364),1))

aic5.wge(winddiff, type = 'bic') # bic and aic picked p = 0 and q = 1

---------WORKING... PLEASE WAIT... 


Five Smallest Values of  bic 
    p    q        bic
    0    1   3.908788
    1    0   3.910454
    1    1   3.924214
    0    2   3.924318
    2    0   3.924622

wind = est.arma.wge(winddiff, p = 0, q = 1)
acf(wind$res)
ljung.wge(wind$res) #  Fail to reject  

Obs 0.007531209 0.02983954 0.01709315 -0.03201086 -0.06295044 -0.03242629 0.01186228 -0.09980544 -0.0365967 -0.004443714 0.02623119 -0.0620031 -0.01971814 0.03985224 0.0187813 0.1125395 -0.006269405 -0.02688986 -0.04856493 -0.09592838 0.01991974 -0.02800076 -0.1347774 0.06464082 

$test
[1] "Ljung-Box test"

$K
[1] 24

$chi.square
[1] 28.54717

$df
[1] 24

$pval
[1] 0.2376395

ljung.wge(wind$res, K=48) # Fail to reject

Obs 0.007531209 0.02983954 0.01709315 -0.03201086 -0.06295044 -0.03242629 0.01186228 -0.09980544 -0.0365967 -0.004443714 0.02623119 -0.0620031 -0.01971814 0.03985224 0.0187813 0.1125395 -0.006269405 -0.02688986 -0.04856493 -0.09592838 0.01991974 -0.02800076 -0.1347774 0.06464082 -0.03134292 0.02687275 0.01003496 0.03298694 0.03970051 -0.001701995 -0.04168581 0.002833127 0.02720862 -0.09361458 0.04431705 0.01422789 -0.0215587 0.04944114 -0.04842808 0.0466781 0.01307725 0.08944093 0.01784868 0.05844817 0.02940169 -0.01060349 -0.06301124 -0.02997102 

$test
[1] "Ljung-Box test"

$K
[1] 48

$chi.square
[1] 46.24967

$df
[1] 48

$pval
[1] 0.5448044

preds_Wind_Speed = fore.arima.wge(daily_bike_data$Wind_Speed, s = 365, phi = wind$phi, theta = wind$theta, n.ahead = 365)

y.arma 2.125 5.434783 7.863636 1.63587 -3.813406 5.25 0.4039855 -5.041667 -17.625 -2.393116 0.6098485 -8.284091 5.166667 4.063406 6.25 2.875 10.3913 18 0.7934783 0.4583333 -8.75 1.853261 -9.105072 -2.317029 2.096014 -14.77083 15.33333 5.86413 6.344203 9.501812 5 9.101449 -5.166667 -6.650362 -0.3985507 1 0.8043478 6.833333 -15.29167 0.3478261 -7.036232 12.14394 13.79167 -6.269928 -18.54167 -7.355072 -10.74457 -1.625 -4.958333 -17.04167 0.3913043 -6.842391 2.597222 6.487319 -0.865942 5.032609 1.25 9.567029 -6.450758 -2.5 -5.416667 -5.416667 -2.833333 5.541667 -7.666667 -9.411232 15.08333 14.83333 10.24621 -0.4836957 0.1213768 -4.213768 6.701087 -4.639493 -3.567029 -6.458333 -8.061594 -16.16667 -3.041667 -11.22283 -9.125 -7.820652 -8.541667 -2.541667 0.75 13.56884 -1.675725 4.333333 9.833333 -5.333333 -0.5416667 -1.666667 8.70471 -19.125 -13.875 -2.916667 9.25 3.208333 6.666667 14.16667 -5.030797 1.365942 2.666667 3 -2.375 -7.75 -1.25 7.375 0.6666667 -11.79167 -11.75 4.291667 7.625 7.458333 4.291667 -13.91667 -9.083333 1.791667 -7.375 -7.916667 4.375 -1.833333 -13.70833 -13.08333 -8.875 -5.041667 -0.7083333 10.45833 8.041667 6.75 12.95833 3.166667 -3.791667 6.041667 4 1.375 -10.375 1.875 1.916667 -2.75 8.958333 5.708333 -7.75 -7.041667 1.25 -3.958333 -2.791667 -1 -1.166667 11 1.541667 -0.7916667 -3.666667 -4.458333 4.083333 9.791667 5.875 -7.416667 1.375 1.708333 0.25 -1.416667 2.958333 -6.083333 4.958333 5.75 -2 1.583333 1.708333 4.875 -0.5 -3.833333 -3.583333 -3.75 -2.833333 -4.291667 13.79167 16.08333 8.541667 -6.041667 -1.333333 3.916667 3.583333 -2.25 3 0.5833333 2.958333 -0.875 -4.125 -2.833333 -0.1666667 -8.75 -3.25 0.04166667 -10.70833 -2.625 -2.791667 -5.416667 -6.791667 0.4583333 3.458333 -0.875 5.375 -2.5 -2.041667 8.083333 -2.375 6.791667 -1.708333 -1.125 0.125 -0.75 0.5833333 -4.333333 -0.4166667 1.25 4.875 4.166667 -4.833333 -5.041667 -2.708333 -2.958333 4.958333 5.416667 -5.958333 -5.791667 -2.666667 -4.458333 -0.125 -0.125 2.583333 -1.208333 -7.958333 -13.66667 -5.125 -11.29167 -9.291667 10.75 -9.833333 -11.78676 2.083333 -0.8333333 -0.4166667 1.791667 -1.791667 -8.125 -3.708333 1.583333 -10.46014 3.041667 -1.413043 10.5 4.75 9.625 0.2101449 -0.6666667 -5.666667 -11.20833 5.583333 -6.666667 -1.791667 13.79167 5.375 1.458333 1.75 13.75 9.708333 6.166667 8.416667 8.458333 -0.9583333 -0.5833333 1.416667 -10.54167 -8.791667 1.416667 -9.333333 -4 -1.916667 16.45833 6.416667 8.458333 9.916667 3 -4.458333 6.25 -5.208333 1.375 0.9583333 0.4583333 -0.5833333 -0.4293478 -19.25 -6.958333 4.916667 -1.208333 -1.625 -6.291667 -1.625 -4.375 0.4166667 3.125 12.16667 7.147727 2.083333 5.041667 8.666667 -0.08333333 -0.6666667 9.666667 7.791667 15.75 19.13768 1.708333 -17.20833 -5.666667 -7.25 2.375 0 1.083333 -9 0.75 0.2083333 3.291667 -3.708333 -1.041667 -18.95833 -1.291667 18.625 5.5 -10.875 6.394928 -3.166667 -10.42754 -10.83333 -2.75 1.916667 -0.08333333 7.5 6.125 -6.125 -7.333333 1.25 -5.041667 8.291667 15.58333 1.5 7.583333 -9.166667 -10.33333 -9.541667 -4.791667 3.25 8.208333 -5.958333 21.91667 8.916667 -3.833333 -5.217391 -4.73913 8.583333 3.762681 2.416667 -0.6666667 8.75 -2.5 

ahead = cbind(Humidity_lag = dplyr::lag(preds_Humidity$f,4),Temperature = preds_Temperature$f,Days_of_the_Week = pred_Days_of_the_Week, Wind_Speed = preds_Wind_Speed$f)

ahead[1:4,1] = daily_bike_data$Humidity[728:731]
fit3 = lm(Total_Users~Humidity_lag + Temperature + Day_of_the_Week + Wind_Speed, data = daily_bike_data)
aic5.wge(fit3$residuals, type = 'bic')

---------WORKING... PLEASE WAIT... 


Five Smallest Values of  bic 
    p    q        bic
    2    1   13.56262
    3    1   13.57134
    2    2   13.57297
    4    1   13.57653
    3    2   13.57783

mlr_forecast = arima(daily_bike_data$Total_Users, order = c(2,0,1),xreg = cbind(daily_bike_data$Humidity_lag, daily_bike_data$Temperature, daily_bike_data$Day_of_the_Week, daily_bike_data$Wind_Speed))

plotts.wge(mlr_forecast$residuals) # looks random
acf(mlr_forecast$residuals[-(1:5)]) # 0/20 acfs out of bounds 

ljung.wge(mlr_forecast$residuals) # greater than 0.05

Obs -0.004575554 0.02747343 -0.04500623 -0.02526262 -0.009007884 0.06994787 -0.02093907 0.009751116 -0.02131838 0.02808664 -0.01937068 -0.007911146 -0.04536793 0.02069547 0.05764346 -0.02793157 0.003017878 -0.03299117 -0.03082105 0.01011359 0.02827371 -0.01110229 -0.02062625 -0.0158372 

$test
[1] "Ljung-Box test"

$K
[1] 24

$chi.square
[1] 15.6043

$df
[1] 24

$pval
[1] 0.9018264

ljung.wge(mlr_forecast$residuals, K =48)

Obs -0.004575554 0.02747343 -0.04500623 -0.02526262 -0.009007884 0.06994787 -0.02093907 0.009751116 -0.02131838 0.02808664 -0.01937068 -0.007911146 -0.04536793 0.02069547 0.05764346 -0.02793157 0.003017878 -0.03299117 -0.03082105 0.01011359 0.02827371 -0.01110229 -0.02062625 -0.0158372 -0.0368657 0.04133905 0.04536202 0.04138776 0.1066994 -0.05252773 -0.01127104 -0.03992349 0.02408238 0.0261171 -0.0009112429 -0.009724457 0.07336766 -0.0660805 0.0360473 -0.0365925 0.04679162 -0.02733777 -0.03693462 -0.03564162 -0.04038826 0.02522348 0.02742891 -0.0160387 

$test
[1] "Ljung-Box test"

$K
[1] 48

$chi.square
[1] 50.44159

$df
[1] 48

$pval
[1] 0.3771725

mlr_st_pred2 = predict(mlr_forecast, newxreg = ahead[1:7,], n.ahead = 7, lastn= FALSE)
plot(seq(1,731,1),daily_bike_data$Total_Users,type = 'l',xlim = c(720,738), main = "Short Term MLR Forecast")
points(seq(732,738,1),mlr_st_pred2$pred,type = 'l', pch = 15,col = 'blue',lwd=2, lty = 2)


mlr_lt_pred2 = predict(mlr_forecast, newxreg = ahead[1:60,], n.ahead = 60, lastn= FALSE)
plot(seq(1,731,1),daily_bike_data$Total_Users,type = 'l',xlim = c(1,785), main = "Long Term MLR Forecast")
points(seq(732,791,1),mlr_lt_pred2$pred,type = 'l', pch = 1,col = 'blue',lwd=2, lty = 2)

# Year Out Forecast
mlr_lt_pred3 = predict(mlr_forecast, newxreg = ahead[1:365,], n.ahead = 365, lastn= FALSE)
plot(seq(1,731,1),daily_bike_data$Total_Users,type = 'l',xlim = c(1,1100), main = "Long Term MLR Forecast")
points(seq(732,1096,1),mlr_lt_pred3$pred,type = 'l', pch = 1,col = 'blue',lwd=2, lty = 2)

VARselect(daily_bike_data[,c(5,8:11,14)])

$selection
AIC(n)  HQ(n)  SC(n) FPE(n) 
     7      7      7      7 

$criteria
                  1            2            3            4            5
AIC(n) 2.762319e+01 2.733958e+01 2.716829e+01 2.689074e+01 2.632813e+01
HQ(n)  2.772619e+01 2.753087e+01 2.744788e+01 2.725862e+01 2.678429e+01
SC(n)  2.789002e+01 2.783512e+01 2.789256e+01 2.784372e+01 2.750982e+01
FPE(n) 9.922004e+11 7.472005e+11 6.296103e+11 4.770590e+11 2.718306e+11
                   6             7             8             9            10
AIC(n) -3.750199e+01 -4.271176e+01 -4.266486e+01 -4.261632e+01 -4.256334e+01
HQ(n)  -3.695753e+01 -4.207901e+01 -4.194382e+01 -4.180699e+01 -4.166572e+01
SC(n)  -3.609158e+01 -4.107264e+01 -4.079703e+01 -4.051977e+01 -4.023808e+01
FPE(n)  5.168071e-17  2.824148e-19  2.960966e-19  3.109863e-19  3.281202e-19

fit2 = VAR(daily_bike_data[,c(5,8:11,14)], p = 7, type = 'trend')


plotts.wge(fit2$varresult$Total_Users$residuals)

acf(fit2$varresult$Total_Users$residuals)

ljung.wge(fit2$varresult$Total_Users$residuals, p = 10)

Obs 0.0005249251 -0.006235651 -0.007748364 -0.02024036 -0.01368047 -0.02223159 -0.02906443 -0.01706459 -0.04874905 0.01789249 -0.01377504 -0.01958757 -0.05185409 0.0353207 0.06875665 -0.01838377 0.01226764 -0.004110181 -0.01557603 0.005239665 0.05216921 0.007511638 0.001240346 0.01256811 

$test
[1] "Ljung-Box test"

$K
[1] 24

$chi.square
[1] 13.29869

$df
[1] 14

$pval
[1] 0.5031507

ljung.wge(fit2$varresult$Total_Users$residuals, p = 10, K = 48)

Obs 0.0005249251 -0.006235651 -0.007748364 -0.02024036 -0.01368047 -0.02223159 -0.02906443 -0.01706459 -0.04874905 0.01789249 -0.01377504 -0.01958757 -0.05185409 0.0353207 0.06875665 -0.01838377 0.01226764 -0.004110181 -0.01557603 0.005239665 0.05216921 0.007511638 0.001240346 0.01256811 -0.03178673 0.05470584 0.01272724 0.03989513 0.1070816 -0.04933038 0.01488104 -0.06148 0.02084819 0.0154614 3.051054e-05 -0.01613748 0.06611603 -0.05755259 0.04242315 -0.04065903 0.04235743 -0.001280656 -0.006977649 0.01617568 -0.037272 0.01445878 0.03332212 0.002087472 

$test
[1] "Ljung-Box test"

$K
[1] 48

$chi.square
[1] 44.16066

$df
[1] 38

$pval
[1] 0.2274342

var_st_pred = predict(fit2, n.ahead = 7, lastn = TRUE)

Warning in summary.lm(x): essentially perfect fit: summary may be unreliable

t = 1:731
plot(seq(1,731,1),daily_bike_data$Total_Users,type = 'l',xlim = c(670,731))
points(t[725:731], var_st_pred$fcst$Total_Users[,1], type="l", lwd=2, lty = 2)

var_st_ase = mean((daily_bike_data$Total_Users[725:731]-var_st_pred$fcst$Total_Users[,1])^2)
var_st_ase

[1] 3303818

var_lt_pred = predict(fit2, n.ahead = 60, lastn = TRUE)

Warning in summary.lm(x): essentially perfect fit: summary may be unreliable

t = 1:731
plot(seq(1,731,1),daily_bike_data$Total_Users,type = 'l',xlim = c(672,731))
points(t[672:731], var_lt_pred$fcst$Total_Users[,1], type="l", lwd=2, lty = 1)

var_lt_ase = mean((daily_bike_data$Total_Users[672:731]-var_lt_pred$fcst$Total_Users[,1])^2)
var_lt_ase

[1] 3407076

var_st_pred2 = predict(fit2, n.ahead = 7, lastn = FALSE)

Warning in summary.lm(x): essentially perfect fit: summary may be unreliable

t = 1:800
plot(seq(1,731,1),daily_bike_data$Total_Users,type = 'l',xlim = c(670,738), main = "Short Term VAR Forecast")
points(t[732:738], var_st_pred2$fcst$Total_Users[,1], type="l", lwd=2, lty = 1, col = 'blue')

var_lt_pred2 = predict(fit2, n.ahead = 60, lastn = FALSE)

Warning in summary.lm(x): essentially perfect fit: summary may be unreliable

t = 1:800
plot(seq(1,731,1),daily_bike_data$Total_Users,type = 'l',xlim = c(670,791), main = "Long Term VAR Forecast")
points(t[732:791], var_lt_pred2$fcst$Total_Users[,1], type="l", lwd=2, lty = 1, col = 'blue')

MLP Model

1. ASE (short and long term forecasts)
2. Rolling Window RMSE (short and long term forecasts (only if univariate)
3. Visualization of Forecasts for both the short- and long-term Horizons.
4. Confidence / Prediction intervals are not required (I don’t have code for confidence / prediction intervals (bootstrap intervals) for MLP models at the moment… but that would be a good thing to work on!  )

# Convert tibble to a data frame with ts() objects
bike_DF <- daily_bike_data %>%
  dplyr::select(-c(Date, Hour, Holiday, Temperature_Feels, Casual_Users, Registered_Users)) %>%  # Remove unnecessary columns
  mutate(across(everything(), ~ zoo(.x, order.by = daily_bike_data$Date))) %>%  # Convert each column to a zoo object
  mutate(across(everything(), ~ as.ts(.x))) %>%  # Convert zoo objects to ts objects
  as.data.frame()  # Convert the tibble to a data frame

bikeShortTrain = bike_DF[1:724,]
bikeShortTest = bike_DF[725:731,]
bikeLongTrain = bike_DF[1:671,]
bikeLongTest = bike_DF[672:731,]
seed = 137

# Forecast Short-term predictor variables using MLP
set.seed(seed)
fit.mlp.short.Season = mlp(ts(bikeShortTrain[,"Season"]),reps = 10, difforder = 0, comb = "mean", det.type = "bin")
fore.mlp.short.Season = forecast(fit.mlp.short.Season, h = 7)
plot(fore.mlp.short.Season)

fit.mlp.short.Day_of_the_Week = mlp(ts(bikeShortTrain[,"Day_of_the_Week"]),reps = 10, difforder = 0, comb = "mean", det.type = "bin")
fore.mlp.short.Day_of_the_Week = forecast(fit.mlp.short.Day_of_the_Week, h = 7)
fore.mlp.short.Day_of_the_Week$mean = round(fore.mlp.short.Day_of_the_Week$mean) # Round to nearest whole number
plot(fore.mlp.short.Day_of_the_Week)

fit.mlp.short.Working_Day = mlp(ts(bikeShortTrain[,"Working_Day"]),reps = 10, difforder = 0, comb = "mean", det.type = "bin")
fore.mlp.short.Working_Day = forecast(fit.mlp.short.Working_Day, h = 7)
fore.mlp.short.Working_Day$mean = round(fore.mlp.short.Working_Day$mean) # Round to nearest whole number
plot(fore.mlp.short.Working_Day)

# fit.mlp.short.Weather_Type = mlp(ts(bikeShortTrain[,"Weather_Type"]),reps = 5, difforder = 0, comb = "mean", det.type = "auto")
# fore.mlp.short.Weather_Type = forecast(fit.mlp.short.Weather_Type, h = 7)
# plot(fore.mlp.short.Weather_Type)

fit.mlp.short.Temperature = mlp(ts(bikeShortTrain[,"Temperature"]),reps = 10, difforder = 0, comb = "mean", det.type = "bin")
fore.mlp.short.Temperature = forecast(fit.mlp.short.Temperature, h = 7)
plot(fore.mlp.short.Temperature)

fit.mlp.short.Humidity = mlp(ts(bikeShortTrain[,"Humidity"]),reps = 10, difforder = 0, comb = "mean", det.type = "bin")
fore.mlp.short.Humidity = forecast(fit.mlp.short.Humidity, h = 7)
plot(fore.mlp.short.Humidity)

fit.mlp.short.Wind_Speed = mlp(ts(bikeShortTrain[,"Wind_Speed"]),reps = 10, difforder = 0, comb = "mean", det.type = "bin")
fore.mlp.short.Wind_Speed = forecast(fit.mlp.short.Wind_Speed, h = 7)
plot(fore.mlp.short.Wind_Speed)

# Forecast Long-term predictor variables using MLP
set.seed(seed)
fit.mlp.long.Season = mlp(ts(bikeLongTrain[,"Season"]),reps = 10, difforder = 0, comb = "median", det.type = "bin")
fore.mlp.long.Season = forecast(fit.mlp.long.Season, h = 60)
plot(fore.mlp.long.Season)

fit.mlp.long.Day_of_the_Week = mlp(ts(bikeLongTrain[,"Day_of_the_Week"]),reps = 10, difforder = 0, comb = "median", det.type = "bin")
fore.mlp.long.Day_of_the_Week = forecast(fit.mlp.long.Day_of_the_Week, h = 60)
fore.mlp.long.Day_of_the_Week$mean = round(fore.mlp.long.Day_of_the_Week$mean) # Round to nearest whole number
plot(fore.mlp.long.Day_of_the_Week)

fit.mlp.long.Working_Day = mlp(ts(bikeLongTrain[,"Working_Day"]),reps = 10, difforder = 0, comb = "median", det.type = "bin")
fore.mlp.long.Working_Day = forecast(fit.mlp.long.Working_Day, h = 60)
fore.mlp.long.Working_Day$mean = round(fore.mlp.long.Working_Day$mean) # Round to nearest whole number
plot(fore.mlp.long.Working_Day)

# fit.mlp.long.Weather_Type = mlp(ts(bikeLongTrain[,"Weather_Type"]),reps = 10, difforder = 0, comb = "mean", det.type = "auto")
# fore.mlp.long.Weather_Type = forecast(fit.mlp.long.Weather_Type, h = 60)
# plot(fore.mlp.long.Weather_Type)

fit.mlp.long.Temperature = mlp(ts(bikeLongTrain[,"Temperature"]),reps = 10, difforder = 0, comb = "mean", det.type = "bin")
fore.mlp.long.Temperature = forecast(fit.mlp.long.Temperature, h = 60)
plot(fore.mlp.long.Temperature)

fit.mlp.long.Humidity = mlp(ts(bikeLongTrain[,"Humidity"]),reps = 10, difforder = 0, comb = "mean", det.type = "bin")
fore.mlp.long.Humidity = forecast(fit.mlp.long.Humidity, h = 60)
plot(fore.mlp.long.Humidity)

fit.mlp.long.Wind_Speed = mlp(ts(bikeLongTrain[,"Wind_Speed"]),reps = 10, difforder = 0, comb = "mean", det.type = "bin")
fore.mlp.long.Wind_Speed = forecast(fit.mlp.long.Wind_Speed, h = 60)
plot(fore.mlp.long.Wind_Speed)

# Pack into data frames
BDF_fore_short = data.frame(Day = ts(seq(1,731,1)),
                            Season = ts(c(bikeShortTrain$Season,fore.mlp.short.Season$mean)),
                            Day_of_the_Week = ts(c(bikeShortTrain$Day_of_the_Week,fore.mlp.short.Day_of_the_Week$mean)),
                            Working_Day = ts(c(bikeShortTrain$Working_Day,fore.mlp.short.Working_Day$mean)),
                            # Weather_Type = ts(c(bikeShortTrain$Weather_Type,fore.mlp.short.Weather_Type$mean)),
                            Temperature = ts(c(bikeShortTrain$Temperature,fore.mlp.short.Temperature$mean)),
                            Humidity = ts(c(bikeShortTrain$Humidity,fore.mlp.short.Humidity$mean)),
                            Wind_Speed = ts(c(bikeShortTrain$Wind_Speed,fore.mlp.short.Wind_Speed$mean)))
BDF_fore_long = data.frame(Day = ts(seq(1,731,1)),
                            Season = ts(c(bikeLongTrain$Season,fore.mlp.long.Season$mean)),
                            Day_of_the_Week = ts(c(bikeLongTrain$Day_of_the_Week,fore.mlp.long.Day_of_the_Week$mean)),
                            Working_Day = ts(c(bikeLongTrain$Working_Day,fore.mlp.long.Working_Day$mean)),
                            # Weather_Type = ts(c(bikeLongTrain$Weather_Type,fore.mlp.long.Weather_Type$mean)),
                            Temperature = ts(c(bikeLongTrain$Temperature,fore.mlp.long.Temperature$mean)),
                            Humidity = ts(c(bikeLongTrain$Humidity,fore.mlp.long.Humidity$mean)),
                            Wind_Speed = ts(c(bikeLongTrain$Wind_Speed,fore.mlp.long.Wind_Speed$mean)))

BDF_xreg_short = data.frame(Day = ts(seq(1,724,1)),
                            Season = ts(c(bikeShortTrain$Season)),
                            Day_of_the_Week = ts(c(bikeShortTrain$Day_of_the_Week)),
                            Working_Day = ts(c(bikeShortTrain$Working_Day)),
                            # Weather_Type = ts(c(bikeShortTrain$Weather_Type)),
                            Temperature = ts(c(bikeShortTrain$Temperature)),
                            Humidity = ts(c(bikeShortTrain$Humidity)),
                            Wind_Speed = ts(c(bikeShortTrain$Wind_Speed)))
BDF_xreg_long = data.frame(Day = ts(seq(1,671,1)),
                            Season = ts(c(bikeLongTrain$Season)),
                            Day_of_the_Week = ts(c(bikeLongTrain$Day_of_the_Week)),
                            Working_Day = ts(c(bikeLongTrain$Working_Day)),
                            # Weather_Type = ts(c(bikeLongTrain$Weather_Type)),
                            Temperature = ts(c(bikeLongTrain$Temperature)),
                            Humidity = ts(c(bikeLongTrain$Humidity)),
                            Wind_Speed = ts(c(bikeLongTrain$Wind_Speed)))

# Fit MLP model for Total_Users
set.seed(seed)
fit.mlp.st = mlp(ts(bikeShortTrain$Total_Users),reps = 10, comb = "median",xreg = BDF_xreg_short, allow.det.season = TRUE, det.type = "bin")
fit.mlp.lt = mlp(ts(bikeLongTrain$Total_Users),reps = 10, comb = "median",xreg = BDF_xreg_long, allow.det.season = TRUE, det.type = "bin")
plot(fit.mlp.lt)

# Forecast and evaluate ASE for short and long
fore.mlp.st = forecast(fit.mlp.st, h = 7, xreg = BDF_fore_short)
fore.mlp.lt = forecast(fit.mlp.lt, h = 60, xreg = BDF_fore_long)
ASE.mlp.st = mean((bikeShortTest$Total_Users - fore.mlp.st$mean)^2)
ASE.mlp.lt = mean((bikeLongTest$Total_Users - fore.mlp.lt$mean)^2)
print(paste("MLP ASE Short Term: ", round(ASE.mlp.st, 2)))

[1] "MLP ASE Short Term:  4177344.82"

print(paste("MLP ASE Long Term: ", round(ASE.mlp.lt, 2)))

[1] "MLP ASE Long Term:  10000456.14"

plot(fore.mlp.st)

plot(fore.mlp.lt)

# Plot the forecasts
t = 1:731
plot(t[720:731],bike_DF$Total_Users[720:731], type = 'l', xlab = "Time", ylab = "Total Users", main = "MLP Short Term Forecast")
lines(t[725:731], fore.mlp.st$mean, type="l", lwd=2, lty = 2, col = 'blue')

plot(t[600:731],bike_DF$Total_Users[600:731], type = 'l', xlab = "Time", ylab = "Total Users", main = "MLP Long Term Forecast")
lines(t[672:731], fore.mlp.lt$mean, type="l", lwd=2, lty = 2, col = 'blue')

Ensemble Model

# Code for Figure 11.37
# TODO: Adopt this for ours
#Ensemble

#VAR p = 7 non seasonal
CMortVAR7 = VAR(cardiacTrain, type = "both", p = 7) #p = 2 from SBC
preds7=predict(CMortVAR7,n.ahead=156)
RMSEVAR7 = sqrt(mean((cardiacTest[,"cmort"] - preds7$fcst$cmort[,1])^2))
RMSEVAR7 # 6.664

#VAR p = 2 seasonal
CMortVAR2S = VAR(cardiacTrain, season = 52, type = "both", p = 2) #p = 2 from SBC
preds2S=predict(CMortVAR2S,n.ahead=156)
ensemble = (preds2S$fcst$cmort[,1] + fore.mlp.cmort$mean)/2

#Plot
plot(seq(1,508,1), cardiac[,"cmort"], type = "l",xlim = c(350,508), ylim = c(70,110), xlab = "Time", ylab = "Cardiac Mortality", main = "52 Week Cardiac Mortality Forecast From A VAR/MLP Ensemble")
lines(seq(353,508,1), ensemble, type = "l", lwd = 4, col = "green")
lines(seq(353,508,1),preds2S$fcst$cmort[,1] , type = "l", lwd = 2, lty = 2, col = "red")
lines(seq(353,508,1),fore.mlp.cmort$mean , type = "l", lwd = 2, lty = 4, col = "blue")
lines(seq(353,508,1),preds7$fcst$cmort[,1] , type = "l", lwd = 2, lty = 2, col = "purple")
RMSEVAR7 = sqrt(mean((cardiacTest[,"cmort"] - preds7$fcst$cmort[,1])^2))
RMSEVAR7
RMSEVAR2S = sqrt(mean((cardiacTest[,"cmort"] - preds2S$fcst$cmort[,1])^2))
RMSEVAR2S
RMSE = sqrt(mean((cardiacTest[,"cmort"] - fore.mlp.cmort$mean)^2))
RMSE
RMSEENSEMBLE = sqrt(mean((cardiacTest[,"cmort"] - ensemble)^2))
RMSEENSEMBLE # 5.64, 5,81

Model Comparison and Final Forecasts

1. Provide a table comparing all models on at least ASE and rwRMSE (if available).
2. Include at least one ensemble model in addition to the models above.
3. Make a case as to why you feel one of your candidate models is the most useful.
4. Provide you final short and long term forecasts with that model.

Attaching package: 'kableExtra'

The following object is masked from 'package:dplyr':

    group_rows

Model Performance Metrics (Short-Term)

Model	ASE	rwRMSE
ARMA	3358954.01	1674.47
ARIMA	3230238.08	1237.39
VAR	3303817.96	NA
MLR	2711048.04	NA
MLP	4177344.82	NA
Ensemble	NA	NA

Model Performance Metrics (Long-Term)

Model	ASE	rwRMSE
ARMA	3058217.31	6297.15
ARIMA	3930823.99	1503.2
VAR	3407075.66	NA
MLR	2215232.01	NA
MLP	10000456.14	NA
Ensemble	NA	NA

Conclusion